perm filename LISP.393[MAC,LSP] blob
sn#329127 filedate 1978-01-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00386 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00072 00002 SAIL RPG 12:53:31 Tuesday, January 17, 1978 FQ+1D.6H.13M.57S.
C00076 00003 SAIL RPG 12:53:31 Tuesday, January 17, 1978 FQ+1D.6H.13M.57S.
C00080 00004 LISP.393[MAC,LSP] 01/17/78 Page 1
C00083 00005 LISP.393[MAC,LSP] 01/17/78 Page 1.1
C00086 00006 LISP.393[MAC,LSP] 01/17/78 Page 1.2
C00089 00007 LISP.393[MAC,LSP] 01/17/78 Page 1.3
C00092 00008 LISP.393[MAC,LSP] 01/17/78 Page 1.4
C00094 00009 ASSEMBLY PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 2
C00099 00010 ASSEMBLY PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 2.1
C00101 00011 STORAGE LAYOUTS LISP.393[MAC,LSP] 01/17/78 Page 3
C00105 00012 STORAGE LAYOUTS LISP.393[MAC,LSP] 01/17/78 Page 3.1
C00108 00013 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 4
C00112 00014 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 4.1
C00115 00015 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 5
C00118 00016 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 6
C00121 00017 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 6.1
C00125 00018 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 6.2
C00127 00019 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 7
C00131 00020 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 8
C00135 00021 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 8.1
C00137 00022 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 9
C00142 00023 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 9.1
C00143 00024 VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 10
C00146 00025 FIRST LOCATIONS, UUO AND INTERRUPT VECTORS LISP.393[MAC,LSP] 01/17/78 Page 11
C00150 00026 FIRST LOCATIONS, UUO AND INTERRUPT VECTORS LISP.393[MAC,LSP] 01/17/78 Page 11.1
C00151 00027 FIRST LOCATIONS, UUO AND INTERRUPT VECTORS LISP.393[MAC,LSP] 01/17/78 Page 12
C00154 00028 SFX HACKERY LISP.393[MAC,LSP] 01/17/78 Page 13
C00157 00029 SFX HACKERY LISP.393[MAC,LSP] 01/17/78 Page 13.1
C00158 00030 SFX HACKERY LISP.393[MAC,LSP] 01/17/78 Page 14
C00162 00031 SFX HACKERY LISP.393[MAC,LSP] 01/17/78 Page 14.1
C00164 00032 INTERRUPT FLAGS AND VARIABLES LISP.393[MAC,LSP] 01/17/78 Page 15
C00169 00033 INTERRUPT FLAGS AND VARIABLES LISP.393[MAC,LSP] 01/17/78 Page 15.1
C00171 00034 ENTRIES TO VARIOUS ROUTINES CALLED BY JSR LISP.393[MAC,LSP] 01/17/78 Page 16
C00175 00035 NEWIO I/O CHANNEL ALLOCATION TABLE LISP.393[MAC,LSP] 01/17/78 Page 17
C00178 00036 INITIAL TTY INPUT FILE ARRAY LISP.393[MAC,LSP] 01/17/78 Page 18
C00182 00037 INITIAL TTY INPUT FILE ARRAY LISP.393[MAC,LSP] 01/17/78 Page 18.1
C00185 00038 INITIAL TTY OUTPUT FILE ARRAY LISP.393[MAC,LSP] 01/17/78 Page 19
C00189 00039 SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 20
C00194 00040 SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 20.1
C00196 00041 SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 21
C00200 00042 SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 21.1
C00202 00043 SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 22
C00206 00044 SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 22.1
C00208 00045 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 23
C00213 00046 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 23.1
C00215 00047 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 24
C00220 00048 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 24.1
C00222 00049 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 25
C00227 00050 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 25.1
C00228 00051 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 26
C00232 00052 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 27
C00236 00053 FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 27.1
C00238 00054 RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 28
C00243 00055 RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 28.1
C00244 00056 RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 29
C00248 00057 RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 30
C00253 00058 RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 30.1
C00256 00059 RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 31
C00259 00060 RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 32
C00264 00061 KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33
C00268 00062 KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33.1
C00272 00063 KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33.2
C00276 00064 KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33.3
C00280 00065 KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33.4
C00281 00066 INITIAL READTABLE, OBARRAY (IN LOW CORE), AND PURTBL LISP.393[MAC,LSP] 01/17/78 Page 34
C00285 00067 INITIAL READTABLE, OBARRAY (IN LOW CORE), AND PURTBL LISP.393[MAC,LSP] 01/17/78 Page 34.1
C00288 00068 OLD I/O BUFFERS, PATCH AREAS LISP.393[MAC,LSP] 01/17/78 Page 35
C00291 00069 OLD I/O BUFFERS, PATCH AREAS LISP.393[MAC,LSP] 01/17/78 Page 35.1
C00295 00070 SEGMENT TABLES LISP.393[MAC,LSP] 01/17/78 Page 36
C00300 00071 SEGMENT TABLES LISP.393[MAC,LSP] 01/17/78 Page 36.1
C00302 00072 SEGMENT TABLES LISP.393[MAC,LSP] 01/17/78 Page 37
C00307 00073 SEGMENT TABLES LISP.393[MAC,LSP] 01/17/78 Page 38
C00311 00074 BEGINNING OF PURE LISP SYSTEM CODE LISP.393[MAC,LSP] 01/17/78 Page 39
C00314 00075 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 40
C00319 00076 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 40.1
C00321 00077 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 41
C00325 00078 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 42
C00329 00079 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 42.1
C00330 00080 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 43
C00334 00081 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 44
C00338 00082 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 44.1
C00339 00083 BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 45
C00342 00084 INITIALIZATION ON ↑G QUIT AND ERRORS LISP.393[MAC,LSP] 01/17/78 Page 46
C00346 00085 INITIALIZATION ON ↑G QUIT AND ERRORS LISP.393[MAC,LSP] 01/17/78 Page 46.1
C00348 00086 INITIALIZATION ON ↑G QUIT AND ERRORS LISP.393[MAC,LSP] 01/17/78 Page 47
C00352 00087 INITIALIZATION ON ↑G QUIT AND ERRORS LISP.393[MAC,LSP] 01/17/78 Page 47.1
C00356 00088 SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 48
C00360 00089 SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 49
C00363 00090 SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 50
C00367 00091 VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 51
C00369 00092 VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 52
C00373 00093 VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 52.1
C00374 00094 VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 53
C00378 00095 VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 53.1
C00379 00096 CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 54
C00383 00097 CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 54.1
C00384 00098 CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 55
C00388 00099 CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 56
C00392 00100 CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 56.1
C00393 00101 CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 57
C00397 00102 CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 57.1
C00398 00103 CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 58
C00400 00104 VARIOUS COMMON EXITS LISP.393[MAC,LSP] 01/17/78 Page 59
C00405 00105 VARIOUS COMMON EXITS LISP.393[MAC,LSP] 01/17/78 Page 59.1
C00406 00106 VARIOUS COMMON SAVE AND RESTORE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 60
C00409 00107 VARIOUS COMMON SAVE AND RESTORE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 60.1
C00410 00108 VARIOUS KINDS OF FRAME MARKERS LISP.393[MAC,LSP] 01/17/78 Page 61
C00414 00109 NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 62
C00419 00110 NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 62.1
C00420 00111 NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 63
C00424 00112 NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 64
C00429 00113 NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 65
C00433 00114 NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 65.1
C00435 00115 SUPPORT FOR LAP/FASLAP CODE LISP.393[MAC,LSP] 01/17/78 Page 66
C00438 00116 SUPPORT FOR COMPILED LSUBRS LISP.393[MAC,LSP] 01/17/78 Page 67
C00443 00117 SUPPORT FOR COMPILED LSUBRS LISP.393[MAC,LSP] 01/17/78 Page 67.1
C00444 00118 VARIOUS LISTING AND DE-LISTING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 68
C00448 00119 VARIOUS LISTING AND DE-LISTING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 68.1
C00450 00120 NOINTERRUPT FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 69
C00454 00121 NOINTERRUPT FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 69.1
C00456 00122 CAR/CDR ROUTINES AND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 70
C00460 00123 CAR/CDR ROUTINES AND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 71
C00465 00124 CAR/CDR ROUTINES AND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 71.1
C00468 00125 SYMBOL CONSER LISP.393[MAC,LSP] 01/17/78 Page 72
C00472 00126 SYMBOL CONSER LISP.393[MAC,LSP] 01/17/78 Page 72.1
C00473 00127 LIST SPACE CONSERS LISP.393[MAC,LSP] 01/17/78 Page 73
C00477 00128 LIST SPACE CONSERS LISP.393[MAC,LSP] 01/17/78 Page 73.1
C00478 00129 NUMBER CONSERS LISP.393[MAC,LSP] 01/17/78 Page 74
C00481 00130 NUMBER CONSERS LISP.393[MAC,LSP] 01/17/78 Page 75
C00484 00131 NUMBER CONSERS LISP.393[MAC,LSP] 01/17/78 Page 75.1
C00485 00132 HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 76
C00489 00133 HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 76.1
C00491 00134 HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 77
C00494 00135 HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 78
C00497 00136 HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 79
C00501 00137 HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 79.1
C00503 00138 ATOM, PLIST, SETPLIST, ASSOC AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 80
C00506 00139 ATOM, PLIST, SETPLIST, ASSOC AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 81
C00510 00140 ATOM, PLIST, SETPLIST, ASSOC AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 81.1
C00511 00141 GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 82
C00515 00142 GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 82.1
C00516 00143 GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 83
C00518 00144 GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 84
C00523 00145 GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 84.1
C00524 00146 GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 85
C00527 00147 NOT, NULL, LAST, BOUNDP, RUNTIME LISP.393[MAC,LSP] 01/17/78 Page 86
C00531 00148 NOT, NULL, LAST, BOUNDP, RUNTIME LISP.393[MAC,LSP] 01/17/78 Page 86.1
C00532 00149 TIME FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 87
C00537 00150 TIME FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 87.1
C00539 00151 EQUAL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 88
C00543 00152 EQUAL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 88.1
C00547 00153 EQUAL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 88.2
C00548 00154 NCONC, *NCONC, APPEND, *APPEND, REVERSE, NREVERSE, NRECONC LISP.393[MAC,LSP] 01/17/78 Page 89
C00552 00155 NCONC, *NCONC, APPEND, *APPEND, REVERSE, NREVERSE, NRECONC LISP.393[MAC,LSP] 01/17/78 Page 89.1
C00554 00156 GENSYM FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 90
C00557 00157 MEMBER, MEMQ, SUBST, DELQ, DELETE, *DELQ, *DELETE LISP.393[MAC,LSP] 01/17/78 Page 91
C00560 00158 MEMBER, MEMQ, SUBST, DELQ, DELETE, *DELQ, *DELETE LISP.393[MAC,LSP] 01/17/78 Page 91.1
C00561 00159 MEMBER, MEMQ, SUBST, DELQ, DELETE, *DELQ, *DELETE LISP.393[MAC,LSP] 01/17/78 Page 92
C00564 00160 FLOATP, FIXP, NUMBERP, TYPEP, AND PDLNMK ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 93
C00566 00161 FLOATP, FIXP, NUMBERP, TYPEP, AND PDLNMK ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 94
C00569 00162 GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 95
C00573 00163 GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 95.1
C00574 00164 GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 96
C00575 00165 GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 97
C00578 00166 GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 98
C00581 00167 GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 98.1
C00583 00168 MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 99
C00586 00169 MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 100
C00591 00170 MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 100.1
C00592 00171 MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 101
C00597 00172 MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 101.1
C00599 00173 MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 102
C00603 00174 VARIOUS BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 103
C00607 00175 VARIOUS BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 103.1
C00611 00176 VARIOUS BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 103.2
C00612 00177 INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 104
C00616 00178 INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 104.1
C00617 00179 INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 105
C00619 00180 INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 106
C00622 00181 INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 107
C00625 00182 INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 107.1
C00626 00183 DEFPROP AND DEFUN LISP.393[MAC,LSP] 01/17/78 Page 108
C00630 00184 DEFPROP AND DEFUN LISP.393[MAC,LSP] 01/17/78 Page 109
C00635 00185 DEFPROP AND DEFUN LISP.393[MAC,LSP] 01/17/78 Page 109.1
C00640 00186 TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 110
C00644 00187 TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 111
C00648 00188 TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 111.1
C00649 00189 TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 112
C00653 00190 TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 112.1
C00655 00191 VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 113
C00658 00192 VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 113.1
C00660 00193 VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 114
C00662 00194 VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 115
C00666 00195 VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 115.1
C00669 00196 VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 115.2
C00673 00197 VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 115.3
C00676 00198 HIGH SEGMENT SAVE ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 116
C00680 00199 HIGH SEGMENT SAVE ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 116.1
C00682 00200 ARGS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 117
C00686 00201 ARGS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 117.1
C00687 00202 EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 118
C00691 00203 EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 118.1
C00692 00204 EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 119
C00696 00205 EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 120
C00700 00206 EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 120.1
C00701 00207 GETCHAR, GETCHARN, AND SUBLIS LISP.393[MAC,LSP] 01/17/78 Page 121
C00705 00208 GETCHAR, GETCHARN, AND SUBLIS LISP.393[MAC,LSP] 01/17/78 Page 121.1
C00707 00209 GETCHAR, GETCHARN, AND SUBLIS LISP.393[MAC,LSP] 01/17/78 Page 122
C00710 00210 GETCHAR, GETCHARN, AND SUBLIS LISP.393[MAC,LSP] 01/17/78 Page 122.1
C00711 00211 SAMEPNAMEP AND ALPHALESSP LISP.393[MAC,LSP] 01/17/78 Page 123
C00715 00212 SAMEPNAMEP AND ALPHALESSP LISP.393[MAC,LSP] 01/17/78 Page 123.1
C00717 00213 COPYSYMBOL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 124
C00719 00214 SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 125
C00723 00215 SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 125.1
C00724 00216 SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 126
C00728 00217 SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 126.1
C00729 00218 SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 127
C00733 00219 SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 127.1
C00734 00220 SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 128
C00737 00221 IOC AND IOG FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 129
C00740 00222 SYSCALL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 130
C00744 00223 SYSCALL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 130.1
C00748 00224 CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 131
C00752 00225 CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 131.1
C00753 00226 CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 132
C00757 00227 CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 132.1
C00761 00228 CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 132.2
C00763 00229 RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 133
C00766 00230 RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 134
C00772 00231 RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 134.1
C00774 00232 RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 135
C00779 00233 RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 135.1
C00780 00234 RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 136
C00784 00235 RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 136.1
C00785 00236 RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 137
C00788 00237 LISTIFY, PNPUT, AND PNGET LISP.393[MAC,LSP] 01/17/78 Page 138
C00792 00238 LISTIFY, PNPUT, AND PNGET LISP.393[MAC,LSP] 01/17/78 Page 138.1
C00793 00239 EXAMINE, DEPOSIT, MAKNUM, MUNKAM LISP.393[MAC,LSP] 01/17/78 Page 139
C00795 00240 SLEEP, LISTEN, ALARMCLOCK LISP.393[MAC,LSP] 01/17/78 Page 140
C00799 00241 SLEEP, LISTEN, ALARMCLOCK LISP.393[MAC,LSP] 01/17/78 Page 140.1
C00803 00242 SLEEP, LISTEN, ALARMCLOCK LISP.393[MAC,LSP] 01/17/78 Page 140.2
C00805 00243 REMOB, ARG, SETARG LISP.393[MAC,LSP] 01/17/78 Page 141
C00809 00244 REMOB, ARG, SETARG LISP.393[MAC,LSP] 01/17/78 Page 141.1
C00810 00245 P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 142
C00814 00246 P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 142.1
C00816 00247 P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 143
C00820 00248 P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 143.1
C00822 00249 P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 144
C00825 00250 P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 144.1
C00826 00251 T.$X AND TBLPUR$X STUFF LISP.393[MAC,LSP] 01/17/78 Page 145
C00831 00252 T.$X AND TBLPUR$X STUFF LISP.393[MAC,LSP] 01/17/78 Page 145.1
C00833 00253 T.$X AND TBLPUR$X STUFF LISP.393[MAC,LSP] 01/17/78 Page 146
C00836 00254 T.$X AND TBLPUR$X STUFF LISP.393[MAC,LSP] 01/17/78 Page 146.1
C00837 00255 PURIFY}G ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 147
C00842 00256 PURIFY}G ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 147.1
C00843 00257 PURIFY}G ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 148
C00846 00258 PURIFY}G ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 148.1
C00849 00259 PURE COPY OF THE READ SYNTAX TABLE LISP.393[MAC,LSP] 01/17/78 Page 149
C00853 00260 PURE COPY OF THE READ SYNTAX TABLE LISP.393[MAC,LSP] 01/17/78 Page 149.1
C00855 00261 PURE COPY OF THE READ SYNTAX TABLE LISP.393[MAC,LSP] 01/17/78 Page 150
C00860 00262 PURE COPY OF THE READ SYNTAX TABLE LISP.393[MAC,LSP] 01/17/78 Page 150.1
C00861 00263 TOP PAGE PGTOP, AND SOME INSRTS LISP.393[MAC,LSP] 01/17/78 Page 151
C00864 00264 EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 152
C00868 00265 EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 152.1
C00869 00266 EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 153
C00873 00267 EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 153.1
C00874 00268 EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 154
C00877 00269 EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 155
C00881 00270 EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 156
C00884 00271 SYMEVAL LISP.393[MAC,LSP] 01/17/78 Page 157
C00886 00272 APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 158
C00890 00273 APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 159
C00892 00274 APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 160
C00894 00275 APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 161
C00898 00276 APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 162
C00902 00277 APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 162.1
C00903 00278 APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 163
C00904 00279 FUNCTION, QUOTE, DECLARE, COMMENT, SETQ, AND, OR LISP.393[MAC,LSP] 01/17/78 Page 164
C00908 00280 FUNCTION, QUOTE, DECLARE, COMMENT, SETQ, AND, OR LISP.393[MAC,LSP] 01/17/78 Page 164.1
C00911 00281 FUNCTION, QUOTE, DECLARE, COMMENT, SETQ, AND, OR LISP.393[MAC,LSP] 01/17/78 Page 165
C00914 00282 PROG, PROGV, RETURN, GO LISP.393[MAC,LSP] 01/17/78 Page 166
C00918 00283 PROG, PROGV, RETURN, GO LISP.393[MAC,LSP] 01/17/78 Page 166.1
C00920 00284 PROG, PROGV, RETURN, GO LISP.393[MAC,LSP] 01/17/78 Page 167
C00923 00285 DO FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 168
C00926 00286 DO FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 169
C00929 00287 DO FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 170
C00932 00288 COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 171
C00935 00289 COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 172
C00938 00290 COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 172.1
C00939 00291 COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 173
C00943 00292 COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 173.1
C00947 00293 STORE, BREAK, SIGNP LISP.393[MAC,LSP] 01/17/78 Page 174
C00951 00294 STORE, BREAK, SIGNP LISP.393[MAC,LSP] 01/17/78 Page 174.1
C00953 00295 PROG2, PROGN, EQ, RPLACA, RPLACD LISP.393[MAC,LSP] 01/17/78 Page 175
C00956 00296 PROG2, PROGN, EQ, RPLACA, RPLACD LISP.393[MAC,LSP] 01/17/78 Page 176
C00957 00297 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 177
C00961 00298 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 177.1
C00962 00299 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 178
C00965 00300 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 179
C00968 00301 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 179.1
C00969 00302 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 180
C00972 00303 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 181
C00976 00304 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 181.1
C00978 00305 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 182
C00981 00306 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 183
C00986 00307 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 183.1
C00988 00308 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 184
C00992 00309 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 184.1
C00994 00310 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 185
C00996 00311 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 186
C01000 00312 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 186.1
C01003 00313 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 187
C01006 00314 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 188
C01009 00315 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 189
C01013 00316 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 189.1
C01015 00317 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 190
C01018 00318 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 191
C01020 00319 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 192
C01023 00320 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 193
C01026 00321 INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 194
C01029 00322 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 195
C01034 00323 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 195.1
C01035 00324 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 196
C01039 00325 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 196.1
C01041 00326 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 197
C01045 00327 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 197.1
C01046 00328 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 198
C01050 00329 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 198.1
C01051 00330 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 199
C01056 00331 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 199.1
C01058 00332 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 200
C01062 00333 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 200.1
C01066 00334 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 201
C01070 00335 USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 201.1
C01074 00336 OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 202
C01078 00337 OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 203
C01081 00338 OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 203.1
C01082 00339 OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 204
C01086 00340 OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 204.1
C01087 00341 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 205
C01090 00342 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 206
C01094 00343 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 207
C01099 00344 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 208
C01103 00345 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 209
C01107 00346 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 210
C01111 00347 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 210.1
C01112 00348 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 211
C01115 00349 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 212
C01119 00350 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 212.1
C01120 00351 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 213
C01123 00352 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 214
C01126 00353 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 215
C01129 00354 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 216
C01132 00355 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 217
C01136 00356 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 218
C01140 00357 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 219
C01144 00358 UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 219.1
C01146 00359 INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 220
C01151 00360 INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 220.1
C01156 00361 INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 220.2
C01160 00362 INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 220.3
C01161 00363 INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 221
C01165 00364 INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 221.1
C01169 00365 INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 221.2
C01171 00366 JCL INITIALIZATION ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 222
C01174 00367 INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 223
C01176 00368 INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 224
C01179 00369 INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 225
C01183 00370 INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 226
C01187 00371 INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 226.1
C01188 00372 INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 227
C01193 00373 INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 228
C01197 00374 INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 229
C01201 00375 STRUCT INSERT, BIT TABLES, AND SPACE CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 230
C01205 00376 STRUCT INSERT, BIT TABLES, AND SPACE CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 230.1
C01208 00377 APOCALYPSE (END OF THE WORLD) LISP.393[MAC,LSP] 01/17/78 Page 231
C01210 00378 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page I
C01220 00379 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page II
C01230 00380 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page III
C01240 00381 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page IV
C01250 00382 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page V
C01260 00383 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page VI
C01270 00384 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page VII
C01280 00385 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page VIII
C01290 00386 Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page IX
C01295 ENDMK
C⊗;
SAIL RPG 12:53:31 Tuesday, January 17, 1978 FQ+1D.6H.13M.57S.
LISP.393[MAC,LSP] Created 12:22 Tuesday, January 17, 1978 FQ+1D.5H.42M.26S.
LLL IIIIIIIII SSSSSSSSS PPPPPPPPPPPP
LLL IIIIIIIII SSSSSSSSS PPPPPPPPPPPP
LLL III SSS SSS PPP PPP
LLL III SSS SSS PPP PPP
LLL III SSS PPP PPP
LLL III SSS PPP PPP
LLL III SSSSSSSSS PPPPPPPPPPPP
LLL III SSSSSSSSS PPPPPPPPPPPP
LLL III SSS PPP
LLL III SSS PPP
LLL III SSS SSS PPP
LLL III SSS SSS PPP
LLLLLLLLLLLLLLL IIIIIIIII SSSSSSSSS PPP
LLLLLLLLLLLLLLL IIIIIIIII SSSSSSSSS PPP
SAIL RPG 12:53:31 Tuesday, January 17, 1978 FQ+1D.6H.13M.57S.
LISP.393[MAC,LSP] Created 12:22 Tuesday, January 17, 1978 FQ+1D.5H.42M.26S.
333333333 999999999 333333333
333333333 999999999 333333333
333 333 999 999 333 333
333 333 999 999 333 333
333 999 999 333
333 999 999 333
333333333 999999999999 333333333
333333333 999999999999 333333333
333 999 333
333 999 333
333 333 999 333 333
333 333 999 333 333
333333333 999999999 333333333
333333333 999999999 333333333
Switch Settings: L[FAIL] % 10000S 54V 120W ↑
SAIL RPG 12:53:31 Tuesday, January 17, 1978 FQ+1D.6H.13M.57S.
LISP.393[MAC,LSP] Created 12:22 Tuesday, January 17, 1978 FQ+1D.5H.42M.26S.
LLL IIIIIIIII SSSSSSSSS PPPPPPPPPPPP
LLL IIIIIIIII SSSSSSSSS PPPPPPPPPPPP
LLL III SSS SSS PPP PPP
LLL III SSS SSS PPP PPP
LLL III SSS PPP PPP
LLL III SSS PPP PPP
LLL III SSSSSSSSS PPPPPPPPPPPP
LLL III SSSSSSSSS PPPPPPPPPPPP
LLL III SSS PPP
LLL III SSS PPP
LLL III SSS SSS PPP
LLL III SSS SSS PPP
LLLLLLLLLLLLLLL IIIIIIIII SSSSSSSSS PPP
LLLLLLLLLLLLLLL IIIIIIIII SSSSSSSSS PPP
SAIL RPG 12:53:31 Tuesday, January 17, 1978 FQ+1D.6H.13M.57S.
LISP.393[MAC,LSP] Created 12:22 Tuesday, January 17, 1978 FQ+1D.5H.42M.26S.
333333333 999999999 333333333
333333333 999999999 333333333
333 333 999 999 333 333
333 333 999 999 333 333
333 999 999 333
333 999 999 333
333333333 999999999999 333333333
333333333 999999999999 333333333
333 999 333
333 999 333
333 333 999 333 333
333 333 999 333 333
333333333 999999999 333333333
333333333 999999999 333333333
Switch Settings: L[FAIL] % 10000S 54V 120W ↑
LISP.393[MAC,LSP] 01/17/78 Page 1
001 COMMENT ⊗ VALID 00231 PAGES
002 C REC PAGE DESCRIPTION
003 C00001 00001
004 C00007 00002
005 C00012 00003
006 C00016 00004
007 C00020 00005
008 C00022 00006
009 C00027 00007
010 C00029 00008
011 C00032 00009
012 C00035 00010
013 C00037 00011
014 C00040 00012
015 C00042 00013
016 C00044 00014
017 C00047 00015
018 C00051 00016
019 C00053 00017
020 C00055 00018
021 C00059 00019
022 C00061 00020
023 C00065 00021
024 C00069 00022
025 C00072 00023
026 C00076 00024
027 C00080 00025
028 C00083 00026
029 C00086 00027
030 C00090 00028
031 C00093 00029
032 C00096 00030
033 C00100 00031
034 C00102 00032
035 C00106 00033
036 C00115 00034
037 C00118 00035
038 C00121 00036
039 C00126 00037
040 C00130 00038
041 C00132 00039
042 C00134 00040
043 C00138 00041
044 C00140 00042
045 C00143 00043
046 C00146 00044
047 C00149 00045
048 C00151 00046
049 C00154 00047
050 C00158 00048
051 C00161 00049
052 C00163 00050
053 C00165 00051
LISP.393[MAC,LSP] 01/17/78 Page 1.1
054 C00166 00052
055 C00169 00053
056 C00172 00054
057 C00175 00055
058 C00178 00056
059 C00181 00057
060 C00184 00058
061 C00186 00059
062 C00189 00060
063 C00191 00061
064 C00193 00062
065 C00196 00063
066 C00198 00064
067 C00201 00065
068 C00204 00066
069 C00206 00067
070 C00210 00068
071 C00213 00069
072 C00216 00070
073 C00218 00071
074 C00223 00072
075 C00226 00073
076 C00229 00074
077 C00231 00075
078 C00233 00076
079 C00236 00077
080 C00238 00078
081 C00240 00079
082 C00243 00080
083 C00245 00081
084 C00247 00082
085 C00249 00083
086 C00250 00084
087 C00254 00085
088 C00256 00086
089 C00259 00087
090 C00263 00088
091 C00267 00089
092 C00270 00090
093 C00272 00091
094 C00274 00092
095 C00276 00093
096 C00277 00094
097 C00279 00095
098 C00282 00096
099 C00283 00097
100 C00285 00098
101 C00288 00099
102 C00290 00100
103 C00294 00101
104 C00298 00102
105 C00300 00103
106 C00304 00104
LISP.393[MAC,LSP] 01/17/78 Page 1.2
107 C00306 00105
108 C00307 00106
109 C00309 00107
110 C00311 00108
111 C00313 00109
112 C00320 00110
113 C00322 00111
114 C00324 00112
115 C00328 00113
116 C00330 00114
117 C00331 00115
118 C00338 00116
119 C00341 00117
120 C00344 00118
121 C00347 00119
122 C00349 00120
123 C00352 00121
124 C00355 00122
125 C00357 00123
126 C00361 00124
127 C00362 00125
128 C00364 00126
129 C00367 00127
130 C00369 00128
131 C00371 00129
132 C00373 00130
133 C00377 00131
134 C00380 00132
135 C00385 00133
136 C00387 00134
137 C00392 00135
138 C00395 00136
139 C00398 00137
140 C00400 00138
141 C00402 00139
142 C00403 00140
143 C00408 00141
144 C00410 00142
145 C00413 00143
146 C00416 00144
147 C00418 00145
148 C00422 00146
149 C00424 00147
150 C00428 00148
151 C00431 00149
152 C00434 00150
153 C00438 00151
154 C00440 00152
155 C00442 00153
156 C00445 00154
157 C00447 00155
158 C00449 00156
159 C00451 00157
LISP.393[MAC,LSP] 01/17/78 Page 1.3
160 C00452 00158
161 C00454 00159
162 C00455 00160
163 C00457 00161
164 C00460 00162
165 C00463 00163
166 C00464 00164
167 C00468 00165
168 C00470 00166
169 C00473 00167
170 C00475 00168
171 C00477 00169
172 C00479 00170
173 C00481 00171
174 C00483 00172
175 C00485 00173
176 C00490 00174
177 C00493 00175
178 C00495 00176
179 C00496 00177
180 C00498 00178
181 C00500 00179
182 C00502 00180
183 C00504 00181
184 C00508 00182
185 C00509 00183
186 C00513 00184
187 C00516 00185
188 C00517 00186
189 C00521 00187
190 C00523 00188
191 C00525 00189
192 C00528 00190
193 C00530 00191
194 C00531 00192
195 C00533 00193
196 C00535 00194
197 C00537 00195
198 C00541 00196
199 C00544 00197
200 C00547 00198
201 C00550 00199
202 C00554 00200
203 C00558 00201
204 C00562 00202
205 C00564 00203
206 C00566 00204
207 C00569 00205
208 C00571 00206
209 C00573 00207
210 C00576 00208
211 C00578 00209
212 C00581 00210
LISP.393[MAC,LSP] 01/17/78 Page 1.4
213 C00584 00211
214 C00586 00212
215 C00589 00213
216 C00591 00214
217 C00593 00215
218 C00595 00216
219 C00597 00217
220 C00600 00218
221 C00602 00219
222 C00605 00220
223 C00613 00221
224 C00617 00222
225 C00619 00223
226 C00621 00224
227 C00623 00225
228 C00625 00226
229 C00628 00227
230 C00631 00228
231 C00633 00229
232 C00636 00230
233 C00640 00231
234 C00642 ENDMK
235 C⊗;
ASSEMBLY PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 2
001
002 ;;; **************************************************************
003 ;;; ***** MACLISP ****** LISP INTERPRETER AND SYSTEM *************
004 ;;; **************************************************************
005 ;;; ** (C) COPYRIGHT 1977 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
006 ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
007 ;;; **************************************************************
008
009 002 026 IFE .OSMIDAS-<SIXBIT \ITS\>, .SYMTAB 16001. ;ENSURE ROOM FOR MANY SYMBOLS
010 .ELSE .SYMTAB 7000.
011
012 220 009 TITLE ***** MACLISP ****** LISP INTERPRETER AND SYSTEM *************
013
014 .NSTGWD ;NO STORAGE WORDS PLEASE UNTIL FIRSTLOC
015 .XCREF A,B,C,AR1,AR2A,T,TT,D,R,F,P,FXP,%
016 .MLLIT==1
017 VERSION==.FNAM2 ;BY CONVENTION, THE SIXBIT FOR THE VERSION NUMBER
018
019
020 SUBTTL ASSEMBLY PARAMETERS
021
022 IF1,[ ;***** CONDITIONAL ASSEMBLY FLAGS AND PARAMETERS *****
023
024 ;" FOR ASSLIS - DO NOT PUT ANY OTHER DOUBLE QUOTES ON THIS PAGE
025
026 ITS==0 ;1 FOR RUNNING UNDER THE ITS MONITOR
027 TOPS10==0 ;1 FOR RUNNING UNDER DEC TOPS-10 MONITOR
028 TOPS20==0 ;1 FOR RUNNING UNDER DEC TOPS-20 MONITOR
029 SAIL==0 ;1 FOR RUNNING UNDER SAIL MONITOR
030 TENEX==0 ;1 FOR RUNNING UNDER THE TENEX MONITOR
031 CMU==0 ;1 FOR RUNNING UNDER THE CMU MONITOR
032 ;LATER WE WILL DEFINE D10==TOPS10\SAIL\CMU AND D20==TENEX\TOPS20
033
034 KA10==0 ;1 FOR KA10 PROCESSOR (WILL ALSO WORK ON KI AND KL)
035 KI10==0 ;1 FOR KI10 PROCESSOR (WILL ALSO WORK ON KL)
036 KL10==0 ;1 FOR KL10 PROCESSOR ONLY
037
038 ML==0 ;1 SAYS THIS LISP IS FOR ML (OR MC) INSTEAD OF AI (ONLY IF ITS==1)
039 MOBIOF==0 ;DISPLAY SLAVE, VIDISSECTOR, A/D, D/A, AND PLOTTER ROUTINES FLAG
040 ; WILL GO AWAY WHEN NEWIO MAKES IT FASLOADABLE
041 BIGNUM==1 ;MULTIPLE PRECISION ROUTINES FLAG
042 EDFLAG==1 ;ROUTINES FOR LISP EDITOR FLAG
043 ; IF 0, CAUSES EDIT TO HAVE AN AUTOLOAD PROPERTY
044 OBTSIZ==777 ;LENGTH OF OBLIST
045 PTCSIZ==40 ;MINIMUM SIZE FOR PATCH AREA
046 FUNAFL==1 ;FUNARG, FAKE ALIST, AND LABEL STUFF
047 NEWRD==0 ;NEW READER FORMAT ETC
048 QIO==0 ;QUUX'S NEWIO STUFF
049 JOBQIO==1 ;SUPPORT FOR INFERIOR PROCEDURES
050 HNKLOG==6 ;LOG2 OF SIZE (IN WORDS) OF LARGEST HUNK (0 => NO HUNKS)
051 USELESS==1 ;NOT PARTICULARLY IMPORTANT FEATURES, LIKE:
052 ; 1) ROMAN NUMERAL READER AND PRINTER
053 ; 2) PRINLEVEL AND PRINLENGTH
ASSEMBLY PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 2.1
054 ; 3) DOUBLE-PRECISION INPUT OF SINGLE-PRECISION FLONUMS
055 ; 4) CURSORPOS
056 ; 5) GCD
057 ; 6) DUMPARRAYS, LOADARRAYS [AUTOLOADED IN NEWIO]
058 ; 7) RECLAIM, AND RETSP FEATURE WHICH RETURNS BPS CORE TO TS SYSTEM
059 ; 8) PURIFY, AND PURE-INITIAL-READ-TABLE
060 ; 9) IN QIO, CLI INTERRUPT SUPPORT
061 ; 10) IN QIO, MAR-BREAK SUPPORT
062 ; 11) IN QIO, AUTOLOAD PROPERTIES FOR ALLFILES ETC.
063 ; 13) CLEVER TERPRI-BEFORE-THE-PARENS HACK
064 ; 14) HUGE TABLE FOR RANDOM NUMBER GENERATOR
065 LHFLAG==1 ;1 FOR CRETINOUS LH FEATURE FOR LONG-TERM MEMORY FOR OWL
066 NIOBFS==1 ;NUMBER OF I/O BUFFERS FOR D10 SYSTEMS
067
068 DBFLAG==0 ;1 FOR DOUBLE-PRECISION FLOATING-POINT NUMBERS
069 CXFLAG==0 ;1 FOR COMPLEX ARITHMETIC
070 NARITH==0 ;1 FOR NEW ARITHMETIC PACKAGE
071
072 ;" FOR ASSLIS - DOUBLE QUOTES ARE OKAY NOW
STORAGE LAYOUTS LISP.393[MAC,LSP] 01/17/78 Page 3
001
002 ;;; IF1
003
004 SUBTTL STORAGE LAYOUTS
005
006 ;;; STORAGE LAYOUT FOR ITS
007 ;;;
008 ;;; BZERSG 0 - - LOW PAGES
009 ;;; ACCUMULATORS, TEMPORARY VARIABLES,
010 ;;; INITIAL READTABLE AND OBARRAY
011 ;;; BSTSG ST: - - SEGMENT TABLES
012 ;;; BSYSSG FIRSTL: INITIAL SYSTEM CODE (PURE)
013 ;;; BSARSG INITIAL SAR SPACE
014 ;;; BVCSG INITIAL VALUE CELL SPACE
015 ;;; BXVCSG [EXTRA VALUE-CELL SEGMENTS - - POSSIBLY NONE]
016 ;;; BIS2SG SYMBOL-BLOCKS
017 ;;; BSYMSG SYMBOL-HEADERS
018 ;;; BSY2SG **SYMBOL-BLOCKS
019 ;;; BPFXSG **FIXNUMS
020 ;;; BPFSSG **LIST-STRUCTURE
021 ;;; BPFLSG [**FLONUMS - - POSSIBLY NONE]
022 ;;; BIFSSG LIST-STRUCTURE
023 ;;; BIFXSG FIXNUMS
024 ;;; BIFLSG FLONUMS
025 ;;; BBNSG BIGNUMS
026 ;;; BBITSG BIT BLOCKS FOR GC
027 ;;; BBPSSG START OF BINARY PROGRAM SPACE
028 ;;; C(BPSL) (ALLOC IS IN THIS AREA)
029 ;;; V(BPORG) START OF BPS UNUSED FOR PROGRAMS
030 ;;; V(BPEND) ARRAYS START NO LOWER THAN THIS
031 ;;; C(BPSH) LAST WORD OF BPS
032 ;;; ... BINARY PROGRAM SPACE GROWS UPWARD ...
033 ;;; C(HINXM) LAST WORD OF GROSS HOLE IN MEMORY
034 ;;; ... LIST STRUCTURE GROWS DOWNWARD ...
035 ;;; PUSHDOWN LISTS WITH HOLES BETWEEN:
036 ;;; FXP, FLP, P, SP
037 ;;;
038 ;;; C(NPDLL) LOW WORD OF NUMBER PDL (LOW OF FXP)
039 ;;; C(NPDLH) HIGH WORD OF NUMBER PDL + 1 (HIGH+1 OF FLP)
040 ;;;
041
042
043 ;;; STORAGE LAYOUT FOR DEC10
044 ;;;
045 ;;; ***** LOW SEGMENT *****
046 ;;; BZERSG 0 - - LOW PAGES
047 ;;; ACCUMULATORS, TEMPORARY VARIABLES,
048 ;;; INITIAL READTABLE AND OBARRAY
049 ;;; BSTSG ST: - - SEGMENT TABLES
050 ;;; BSARSG INITIAL SAR SPACE
051 ;;; BVCSG INITIAL VALUE CELL SPACE
052 ;;; BXVCSG [EXTRA VALUE-CELL SEGMENTS - - POSSIBLY NONE]
053 ;;; BIS2SG SYMBOL-BLOCKS
STORAGE LAYOUTS LISP.393[MAC,LSP] 01/17/78 Page 3.1
054 ;;; BSYMSG SYMBOL-HEADERS
055 ;;; BIFSSG LIST-STRUCTURE
056 ;;; BIFXSG FIXNUMS
057 ;;; BIFLSG FLONUMS
058 ;;; BBNSG BIGNUMS
059 ;;; BBITSG BIT BLOCKS FOR GC
060 ;;; PUSHDOWN LISTS:
061 ;;; FXP, FLP, P, SP
062 ;;; C(NPDLL) LOW WORD OF NUMBER PDL (LOW OF FXP)
063 ;;; C(NPDLH) HIGH WORD OF NUMBER PDL + 1 (HIGH+1 OF FLP)
064 ;;; BBPSSG START OF BINARY PROGRAM SPACE
065 ;;; (ALLOC IS IN THIS AREA)
066 ;;; V(BPORG) START OF BPS UNUSED FOR PROGRAMS
067 ;;; V(BPEND) ARRAYS START NO LOWER THAN THIS
068 ;;; C(BPSH) LAST WORD OF BPS (FIXED, SET BY ALLOC)
069 ;;; C(HIXM) HIGH WORD OF EXISTING MEMORY
070 ;;; C(MAXNXM) HIGHEST WORD OF NXM THAT MAY BE USED
071 ;;;
072 ;;; ***** HIGH SEGMENT *****
073 ;;; BSYSSG INITIAL SYSTEM CODE (PURE)
074 ;;; BSY2SG **SYMBOL-BLOCKS
075 ;;; BPFXSG **FIXNUMS
076 ;;; BPFSSG **LIST-STRUCTURE
077 ;;; BPFLSG [**FLONUMS - - POSSIBLY NONE]
078 ;;; BPFSSG INITIAL PURE LIST STRUCTURE
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 4
001
002 ;;; IF1
003
004 SUBTTL VARIOUS PARAMETER CALCULATIONS
005
006 LVRNO==.FNAM2
007 004 006 IFGE LVRNO,[
008 LVRNO==<LVRNO←-6>+<SIXBIT \1\> ;HACK FOR CROSSING 1000'S
009 ;IFN <<LVRNO←-30>&77>-'9, LVRNO==LVRNO+<1←36> ;INSTALL THIS LINE WHEN 1900 REACHED
010 ] ;END OF IFGE LVRNO
011
012 002 017 PRINTX \MACLISP VERSION \ ;PRINT OUT VERSION OF THIS LISP
013 .TYO6 .OFNM2
014 PRINTX \ [\ ;WATCH OUT FOR THE BRACKETS!
015 004 006 .TYO6 LVRNO
016 PRINTX \] ASSEMBLED ON \
017 .TYO6 .OSMIDAS
018 PRINTX \ AT \
019 IFE <.SITE 0>, PRINTX \UNKNOWN SITE\
020 .ELSE REPEAT 20, IFE <.SITE .RPCNT>,[.ISTOP] .TYO6 <.SITE .RPCNT>
021 PRINTX \
022 \ ;TERPRI TO FINISH VERSION MESSAGE
023
024 ;;; HACK FLAGS AND PARAMETERS
025
026 DEFINE ZZZZZZ X,SYM,VAL
027 IFSE [X]-, PRINTX \* \
028 .ELSE PRINTX \ \
029 PRINTX \SYM=VAL
030 \
031 TERMIN
032
033 PRINTX \INITIAL SWITCH VALUES (*=EXPERIMENTAL):
034 \
035
036 ;X=- => EXPERIMENTAL SWITCH
037 002 036 IRPS S,X,[ITS,TOPS10,TOPS20-SAIL,TENEX-CMU-KA10,KI10-KL10-
038 002 051 ML,MOBIOF,BIGNUM,EDFLAG,OBTSIZ,FUNAFL,QIO,JOBQIO,HNKLOG,USELESS,
039 002 070 DBFLAG-CXFLAG-NARITH-]
040 004 026 ZZZZZZ [X]S,\S
041 TERMIN
042 004 026 EXPUNGE ZZZZZZ
043
044 PRINTC \REDEFINITIONS:
045 \
046 .INSRT TTY:
047 PRINTC \
048 \
049
050 ;;; ALL FLAGS WHICH ARE NON-ZERO MUST BE ONES: MUCH CONDITIONAL
051 ;;; ASSEMBLY DOES ARITHMETIC WITH THEM.
052
053 002 036 IRP FOO,,[ITS,TOPS10,TOPS20,SAIL,TENEX,CMU,KA10,KI10,KL10
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 4.1
054 002 051 ML,MOBIOF,BIGNUM,EDFLAG,FUNAFL,NEWRD,QIO,JOBQIO,USELESS
055 002 070 LHFLAG,DBFLAG,CXFLAG,NARITH]
056 004 056 IFN FOO, FOO==:1
057 .ELSE FOO==:0
058 TERMIN ;USE OF ==: PREVENTS CHANGING THEM RANDOMLY
059
060 ;;; CHECK MUTUALLY EXCLUSIVE FLAGS OF WHICH ONE MUST BE SET
061
062 DEFINE MUTXOR FLAGS,DEFAULT
063 ZZZ==0
064 IRP X,Y,[FLAGS]
065 004 063 ZZZ==ZZZ+X
066 IRP Z,,[Y]
067 IFN X*Z, .FATAL BOTH X AND Z SPECIFIED AMONG {FLAGS}
068 TERMIN
069 TERMIN
070 004 063 IFE ZZZ,[
071 PRINTX \NONE OF {FLAGS} SPECIFIED - ASSUMING DEFAULT==:1
072 \
073 004 071 EXPUNGE DEFAULT
074 DEFAULT==:1
075 ] ;END OF IFE ZZZ
076 004 063 EXPUNGE ZZZ
077 TERMIN
078
079 002 031 IRP OS,,[ITS,DEC,SAIL,TENEX,CMU]FLAG,,[ITS,TOPS10,SAIL,TENEX,CMU]
080 002 031 IFE .OSMIDAS-<SIXBIT \OS\>, MUTXOR [ITS,TOPS10,TOPS20,SAIL,TENEX,CMU]OS
081 TERMIN
082
083 002 034 MUTXOR [KA10,KI10,KL10]KA10
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 5
001
002 ;;; IF1
003
004
005 002 031 D10==:TOPS10\SAIL\CMU ;SWITCH FOR DEC-10-LIKE SYSTEMS
006 002 030 D20==:TOPS20\TENEX ;SWITCH FOR DEC-20-LIKE SYSTEMS
007
008 ;;; INSIST FORCIBLY ALTERS A PARAMETER IF NECESSARY.
009
010 DEFINE INSIST COND,SET
011 171 005 COND,[
012 102 039 IRPS X,,[SET]
013 ZZZ==X
014 EXPUNGE X
015 102 039 SET
016 004 063 IFN X-ZZZ,[
017 102 039 PRINTX \ COND =>SET
018 \
019 ]
020 004 063 EXPUNGE ZZZ
021 .ISTOP
022 TERMIN
023 ] ;END OF COND
024 TERMIN
025
026 ;;; CANONICALIZE BITS
027
028 002 026 INSIST IFE ITS, MOBIOF==:0
029 002 026 INSIST IFE ML+<1-ITS>, MOBIOF==:1
030
031 002 048 INSIST IFN QIO, MOBIOF==:0
032
033 002 048 INSIST IFE QIO, JOBQIO==:0
034 002 026 INSIST IFE ITS, JOBQIO==:0
035 002 026 INSIST IFE ITS, LHFLAG==:0
036 002 066 INSIST IFG SAIL*<6-NIOBFS>, NIOBFS==:6
037
038 002 028 INSIST IFN TOPS20, KA10==:0
039 002 028 INSIST IFN TOPS20, KI10==:0
040 002 028 INSIST IFN TOPS20, KL10==:1
041
042 SEGLOG==:11 ;LOG2 OF # OF WORDS PER SEGMENT (WARNING! BUILT INTO NCOMPLR!)
043 002 050 INSIST IFGE HNKLOG-SEGLOG, HNKLOG==:SEGLOG/2
044
045 002 044 OBTSIZ==:OBTSIZ\1 ;MUST BE ODD
046 002 069 DXFLAG==:DBFLAG*CXFLAG
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 6
001
002 ;;; IF1
003
004
005 002 026 IFE .OSMIDAS-<SIXBIT \ITS\>,[
006 DEFINE $INSRT $%$%$%
007 .INSRT $%$%$% >
008 PRINTX \ ==> INSERTED: \
009 .TYO6 .IFNM1
010 PRINTX \ \
011 .TYO6 .IFNM2
012 PRINTX \
013 \
014 TERMIN
015 ] ;END OF IFE .OSMIDAS-<SIXBIT \ITS\>,
016 .ELSE,[
017 DEFINE $INSRT $%$%$%
018 .INSRT $%$%$%!.MID
019 PRINTX \INSERTED: \
020 .TYO6 .IFNM1
021 PRINTX \.\
022 .TYO6 .IFNM2
023 PRINTX \
024 \
025 TERMIN
026 ] ;END OF .ELSE
027
028
029 ;;; MAKE SURE THE SYMBOLS WE WILL NEED ARE DEFINED.
030 ;;; THEY MAY NOT BE IF ASSEMBLING FOR A DIFFERENT OPERATING SYSTEM
031
032 DEFINE FLUSHER DEF/
033 004 029 IRPS SYM,,[DEF]
034 004 029 EXPUNGE SYM
035 .ISTOP
036 TERMIN
037 TERMIN
038
039 DEFINE SYMFLS TARGETSYS,OS,.DEFS.,DEFFER,CHKSYM,.BITS.,CHKBIT
040 IFE <.OSMIDAS-SIXBIT\OS\>,[
041 IFE TARGETSYS,[
042 PRINTX \FLUSHING OS SYMBOL DEFINITIONS
043 \
044 006 006 $INSRT .DEFS.
045 006 032 DEFFER FLUSHER
046 IFSN .BITS.,,[
047 PRINTX \FLUSHING OS BIT DEFINITIONS
048 \
049 006 032 EQUALS DEFSYM,FLUSHER
050 006 006 $INSRT .BITS.
051 EXPUNGE DEFSYM
052 ] ;END OF IFSN .BITS.
053 ] ;END OF IFE TARGETSYS
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 6.1
054 ] ;END OF IFE <.OSMIDAS-SIXBIT\OS\>
055 TERMIN
056
057 DEFINE SYMDEF TARGETSYS,OS,.DEFS.,DEFFER,CHKSYM,.BITS.,CHKBIT
058 IFN TARGETSYS,[
059 IFN <.OSMIDAS-SIXBIT\OS\>,[
060 PRINTX \MAKING OS SYMBOL DEFINITIONS
061 \
062 006 006 $INSRT .DEFS.
063 DEFFER
064 IFSN .BITS.,,[
065 PRINTX \MAKING OS BIT DEFINITIONS
066 \
067 006 006 $INSRT .BITS.
068 ] ;END OF IFSN .BITS.,,
069 ] ;END OF IFN <.OSMIDAS-SIXBIT\OS\>
070 .ELSE,[
071 IFNDEF CHKSYM,[
072 PRINTX \FUNNY - RUNNING ON OS, BUT CHKSYM UNDEFINED; MAKING OS SYMBOL DEFINITIONS
073 \
074 006 006 $INSRT .DEFS.
075 DEFFER
076 ] ;END OF IFNDEF CHKSYM
077 IFSN .BITS.,,[
078 IFNDEF CHKBIT,[
079 PRINTX \FUNNY - RUNNING ON OS, BUT CHKBIT UNDEFINED; MAKING OS BIT DEFINITIONS
080 \
081 006 006 $INSRT .BITS.
082 ] ;END OF IFNDEF CHKBIT
083 ] ;END OF IFSN .BITS.,,
084 ] ;END OF .ELSE
085 ] ;END OF IFN TARGETSYS
086 TERMIN
087
088 005 006 IFN D20, EXPUNGE RESET
089
090 006 057 IRP HACK,,[SYMFLS,SYMDEF]
091 002 026 HACK ITS,ITS,ITSDFS,.ITSDF,.IOT,ITSBTS,%PIC.Z
092 002 027 HACK TOPS10,DEC,DECDFS,.DECDF,LOOKUP,DECBTS,.GTSTS
093 002 030 HACK TOPS20,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
094 002 029 HACK SAIL,SAIL,SAIDFS,.DECDF,SPCWAR,DECBTS,.GTSTS
095 002 030 HACK TENEX,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
096 002 031 HACK CMU,CMU,CMUDFS,.DECDF,CMUDEC,DECBTS,.GTSTS
097 TERMIN
098
099 ;;; CONFLICTS WITH UNLOCKI MACRO AND SEGSIZ VARIABLE
100 008 004 IFN SAIL, EXPUNGE UNLOCK SEGSIZ
101
102 006 008 COMMENT | MAKE @ PROGRAM UNDERSTAND POTENTIAL FILE INSERTIONS
103 ;TABS IN FRONT OF $INSRT'S ARE NECESSARY TO FAKE OUT UNIFY PROGRAM
104 006 006 $INSRT ITSDFS
105 006 006 $INSRT DECDFS
106 006 006 $INSRT TNXDFS
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 6.2
107 006 006 $INSRT SAIDFS
108 006 006 $INSRT CMUDFS
109 006 006 $INSRT ITSBTS
110 006 006 $INSRT DECBTS
111 006 006 $INSRT TWXBTS
112 | ;END OF COMMENT
113
114 005 006 IFN D10\D20,[
115 DEFINE HALT
116 209 011 JRST 4,.!TERMIN
117
118 EXPUNGE .VALUE
119 006 115 EQUALS .VALUE HALT
120
121 DEFINE .LOSE <A>
122 209 011 JRST 4,.-1!TERMIN
123
124 ] ;END OF IFN D10\D20
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 7
001
002 ;;; IF1
003
004
005 ;;; LOSING KL10 HAS A FIX INSTRUCTION
006 EXPUNGE FIX
007 ;;; CALL IS A DEC UUO, BUT WE USE THAT NAME FOR A LISP UUO
008 205 008 EXPUNGE CALL
009
010 ;;; DON'T HACK THIS $INSRT - UNIFY DEPENDS ON IT
011 006 006 $INSRT DEFNS ;STANDARD AC, UUO, AND MACRO DEFINITIONS
012
013 ;;; DON'T HACK THIS $INSRT - UNIFY DEPENDS ON IT
014 006 006 $INSRT MACS ;LOTSA MOBY MACROS
015
016
017 SA% LRCT==:NASCII+10 ;SPACE SUFFICIENT FOR CHARS AND SWITCHES
018 SA$ LRCT==:1010
019 10$ LIOBUF==:200 ;LENGTH OF STANDARD VANILLA I/O BUFFER
020
021
022 LONUM==400 ;MINIMUM MAGNITUDE OF LOWEST NEGATIVE INUM
023 HINUM==1000 ;MINIMUM MAGNITUDE OF LARGEST POSITIVE INUM
024 ;SOME CODE ASSUMES HINUM IS AT LEAST 777
025 ;MUCH CODE ASSUMES HINUM IS AT LEAST 177 (FOR ASCII CHARS)
026
027
028 002 026 IFN ITS, PAGLOG==:12 ;LOG2 OF PAGE SIZE (DAMN WELL BETTER BE 12 FOR ITS!!!
029 005 005 IFN D10, PAGLOG==:11 ; SOME CODE ASSUMES IT WILL BE 11 OR 12)
030 005 006 IFN D20, WARN [THINK ABOUT D20 PAGLOG]
031
032 MEMORY==:<1,,0> ;SIZE OF MEMORY!!!
033 007 028 PAGSIZ==:1←PAGLOG ;PAGE SIZE
034 007 028 PAGMSK==:<777777←PAGLOG>&777777 ;MASKS ADDRESSES TO PAGE BOUNDARY
035 007 034 PAGKSM==:PAGMSK#777777 ;MASKS WORD ADDRESS WITHIN PAGE
036 007 033 NPAGS==:MEMORY/PAGSIZ ;NUMBER OF PAGES IN MEMORY
037
038 002 069 NNUMTP==:2+BIGNUM+DBFLAG+CXFLAG+DBFLAG*CXFLAG ;NUMBER OF NUMBER TYPES
039 002 050 NTYPES==:3+HNKLOG+NNUMTP+1 ;NUMBER OF DATA TYPES, COUNTING RANDOM
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 8
001
002 ;;; IF1
003
004 005 042 SEGSIZ==:1←SEGLOG ;SEGMENT SIZE
005 005 042 SEGMSK==:<777777←SEGLOG>&777777 ;MASKS ADDRESSES TO SEGMENT BOUNDARY
006 008 005 SEGKSM==:SEGMSK#777777 ;MASKS WORD ADDRESS WITHIN SEGMENT
007 007 032 NSEGS==:MEMORY/SEGSIZ ;NUMBER OF SEGMENTS IN MEMORY
008 008 004 BTBSIZ==:SEGSIZ/40 ;SIZE OF BIT BLOCKS (ENOUGH BITS FOR A SEGMENT, 40 PER WORD)
009 007 036 SGS%PG==:NSEGS/NPAGS ;NUMBER OF SEGMENTS PER PAGE
010
011 BTSGGS==1 ;GUESS AT THE NUMBER OF INITIAL BIT SEGMENTS
012
013 002 026 IFN ITS,[
014 007 033 ALPDL==4*PAGSIZ ;DEFAULT TOTAL PDL SIZES
015 007 033 ALFXP==4*PAGSIZ
016 007 033 ALFLP==1*PAGSIZ
017 007 033 ALSPDL==2*PAGSIZ
018 ] ;END OF IFN ITS
019 005 005 IFN D10,[
020 008 004 ALFXP==SEGSIZ ;DEFAULT TOTAL PDL SIZES
021 008 004 ALFLP==SEGSIZ
022 ALPDL==3000
023 ALSPDL==1400
024 ] ;END OF IFN D10
025
026
027 ;;; GROSSLY DETERMINE MIN AND MAX PARAMETERS FOR EACH SPACE AND PDL
028
029 DEFINE FUMBLE FF,RIDER,SPECS ;FOR SPACES
030 008 004 STUMBLE FUMBLE,FF,RIDER,0,SEGSIZ,[SPECS]
031 TERMIN
032
033 DEFINE GRUMBLE PDL,RIDER,SPECS ;FOR PDLS
034 008 033 STUMBLE GRUMBLE,PDL,RIDER,20,100,[SPECS]
035 TERMIN
036
037 DEFINE STUMBLE NAME,FF,RIDER=[IFE 0],LO,HI,%SPECS
038 ZZZ==0
039 IRP SPEC,,[%SPECS]
040 171 005 IRP COND,VALS,[SPEC]
041 171 005 IFN COND,[
042 IRP M,,[MIN,MAX]Q,,[LO,HI]V,,VALS
043 RIDER,[
044 IFL V-Q, M!!FF==:Q
045 .ELSE M!!FF==:V
046 ]
047 .ELSE M!!FF==:0
048 TERMIN
049 004 063 ZZZ==ZZZ+1
050 ]
051 .ISTOP
052 TERMIN
053 TERMIN
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 8.1
054 004 063 IFN ZZZ-1, WARN \ZZZ,[ SPECS SUCCEEDED FOR NAME FF]
055 004 063 EXPUNGE ZZZ
056 TERMIN
057
058 023 014 FUMBLE FFS,,[[1,[0.25,40000]]]
059 023 015 FUMBLE FFX,,[[ITS,[0.2,14000]],[D10,[0.25,3000]]]
060 023 016 FUMBLE FFL,,[[ITS,[0.15,2*SEGSIZ]],[D10,[0.25,SEGSIZ]]]
061 023 017 FUMBLE FFD,IFN DBFLAG,[[1,[0,SEGSIZ]]]
062 023 018 FUMBLE FFC,IFN CXFLAG,[[1,[0,SEGSIZ]]]
063 023 019 FUMBLE FFZ,IFN DXFLAG,[[1,[0,SEGSIZ]]]
064 023 020 FUMBLE FFB,IFN BIGNUM,[[ITS,[3*SEGSIZ/4,2*SEGSIZ]],[D10,[0.2,SEGSIZ]]]
065 023 021 FUMBLE FFY,,[[ITS,[SEGSIZ/2,6000]],[D10,[SEGSIZ/2,3*SEGSIZ]]]
066 023 022 FUMBLE FFH,IFN HNKLOG,[[1,[0,2*SEGSIZ]]]
067 023 023 FUMBLE FFA,,[[1,[40,SEGSIZ]]]
068 008 033 GRUMBLE PDL,,[[1,[200,1400]]]
069 008 033 GRUMBLE SPDL,,[[1,[100,1400]]]
070 008 033 GRUMBLE FXP,,[[1,[200,1000]]]
071 008 033 GRUMBLE FLP,,[[1,[20,200]]]
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 9
001
002 ;;; IF1
003
004
005 ;;; ********** INTERRUPT BITS **********
006
007 002 026 IFN ITS,[
008
009 ;;; THESE NAMES SHOULD BE PHASED OUT IN FAVOR OF THE ITS-STANDARD %PI SERIES.
010
011 ;;; LISP SETS ITS INTERRUPT MASK (.MASK USET VARIABLE) ONLY FROM
012 ;;; THE CONTENTS OF LOCATION IMASK, WHICH INITIALLY CONTAINS STDMSK.
013 ;;; DEPOSITING DBGMSK THERE BEFORE STARTUP DISABLES ALL INTERRUPTS
014 ;;; EXCEPT TTY AND PDL OVERFLOW, SO THAT DDT WILL TRAP ILOP, MPV, ETC.
015
016 IB.ALARM==200000,, ; REAL TIME CLOCK (ALARM CLOCK)
017 IB.TIMER==100000,, ; RUN TIME CLOCK
018 IB.PARITY==1000,, ;+ PARITY ERROR
019 IB.FLOV==400,, ; FLOATING OVERFLOW
020 IB.PURE==200,, ;+ PURE PAGE TRAP (WRITE INTO READ-ONLY)
021 IB.PCPURE==100,, ;+ PURE INSTRUCTION FETCH FROM IMPURE
022 IB.SYSUUO==40,, ;+ SYS UUO TRAP
023 IB.AT3==20,, ; ARM TIP BREAK 3
024 IB.AT2==10,, ; ARM TIP BREAK 2
025 IB.AT1==4,, ; ARM TIP BREAK 1
026 IB.DEBUG==2,, ; SYSTEM BEING DEBUGGED
027 IB.RVIOL==1,, ;+ RESTRICTION VIOLATION (?)
028 IB.CLI==400000 ; CORE LINK INTERRUPT
029 IB.PDLOV==200000 ; PDL OVERFLOW
030 IB.LTPEN==100000 ; LIGHT PEN INTERRUPT
031 IB.MAR==40000 ;+ MAR INTERRUPT
032 IB.MPV==20000 ;+ MEMORY PROTECTION VIOLATION
033 IB.SCLK==10000 ; SLOW CLOCK TICK (.5 SEC)
034 IB.1PROC==4000 ;* SINGLE INSTRUCTION PROCEED
035 IB.BREAK==2000 ;* .BREAK EXECUTED
036 IB.ILAD==1000 ;+ ILLEGAL USER ADDRESS
037 IB.IOC==400 ;+ I/O CHANNEL ERROR
038 IB.VALUE==200 ;* .VALUE EXECUTED
039 IB.DOWN==100 ; SYSTEM GOING DOWN OR BEING REVIVED
040 IB.ILOP==40 ;+ ILLEGAL INSTRUCTION OPERATION
041 IB.DMPV==20 ;+ DISPLAY MEMORY PROTECTION VIOLATION
042 IB.AROV==10 ; ARITHMETIC OVERFLOW
043 IB.42BAD==4 ;* BAD LOCATION 42
044 IB.C.Z==2 ;* ↑Z TYPED WHEN THIS JOB HAD TTY
045 IB.TTY==1 ; INTERRUPT CHAR TYPED ON TTY
046
047 129 006 Q% STDMSK=:IB<TTY+ILOP+IOC+MPV+PDLOV+TIMER+ALARM+PURE>
048 004 046 Q% DBGMSK=:IB<TTY+PDLOV>
049
050 ] ;END OF IFN ITS
051 005 005 IFN D10,[
052 IB.PDLOV==200000 ; PDL OVERFLOW
053 IB.MPV==20000 ;+ MEMORY PROTECTION VIOLATION
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 9.1
054
055 Q% STDMSK==:630000
056 ] ;END OF IFN D10
VARIOUS PARAMETER CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 10
001
002 ;;; IF1
003
004 ;;; ********** I/O CHANNEL ASSIGNMENTS **********
005
006 002 048 IFE QIO,[
007 ERRC==:0 ;ERROR MESSAGE CHANNEL
008 010 007 TMPC==:ERRC
009 TYIC==:1 ;TTY INPUT
010 TYOC==:2 ;TTY OUTPUT
011 UTIC==:3 ;UREAD ("U-TAPE") INPUT (↑Q)
012 UTOC==:4 ;UWRITE OUTPUT (↑R)
013 LPTC==:5 ;LINE PRINTER (↑B) OUTPUT
014 DSIC==:6 ;DISK CHANNEL (USED FOR BOTH INPUT AND OUTPUT)
015 002 039 IFN MOBIOF,[
016 IPLC==:7 ;INTERPRETIVE PLOTTER
017 VIDC==:10 ;VIDISECTOR
018 NVDC==:11 ;FAKE VIDISECTOR
019 IMXC==:12 ;MULTIPLEXER INPUT
020 OMXC==:13 ;MULTIPLEXER OUTPUT
021 BVDC==:14 ;BLOCK VIDI INPUT
022 DISC==:15 ;DISPLAY OUTPUT
023 SIXC==:16 ;PDP-6 CHANNEL (DISPLAY SLAVE)
024 010 021 FTVC==:BVDC ;CANT BE USING BOTH FAKE TV AND BLOCK VIDI INPUT
025 ] ;END OF IFN MOBIOF
026 005 005 IFN D10,[
027 DELC==:7 ;RANDOM I/O CHANNEL FOR DEC-10
028 ] ;END OF IFN D10
029 002 039 IT$ IFE MOBIOF, NOFCH==:7 ;NUMBER OF I/O CHANNELS
030 002 039 IT$ IFN MOBIOF, NOFCH==:17
031 10$ NOFCH==:10
032 ] ;END OF IFE QIO
033
034 ;;; PAGE 376 IS RESERVED FOR COPYING (SEE IP1), AND 377 FOR DISUSE.
035 ;;; (THE DISUSE AS TO DO WITH AN OLD HARDWARE BUG IN BLT.)
036 ;;; ON AI, PAGE 375 IS FOR MAPPING PAGE 0 OF THE DISPLAY SLAVE.
037
038 007 033 IT$ Q% P6=MEMORY-3*PAGSIZ ;PAGE 0 OF PDP6 SLAVE IS MAPPED INTO PDP-10 MEMORY
039
040 ] ;END OF IF1
FIRST LOCATIONS, UUO AND INTERRUPT VECTORS LISP.393[MAC,LSP] 01/17/78 Page 11
001
002 SUBTTL FIRST LOCATIONS, UUO AND INTERRUPT VECTORS
003
004 ;IFE <ITS+TENEX>*USELESS, NPGTPS==0
005 IFE 0, NPGTPS==0
006 TOPN==0
007 BOTN==0
008 .XCREF TOPN BOTN
009 002 030 IFN ITS+TENEX,[
010 NPURTR==0
011 Q$ NIOCTR==0
012 .XCREF PURTR1 NPURTR NIOCTR
013 ] ;END OF IFN ITS+TENEX
014 N2DIF==0
015 NPRO==0+1 ;NUMBER OF INTERRUPT PROTECTION REGIONS
016 ;NOTE DEFN OF PRO0 IN MACS FILE
017 .XCREF NPRO
018
019
020 005 005 IFN D10,[
021 .DECTWO ;DEC TWO-SEGMENT RELOC OUTPUT
022 %LOSEG==-1 ;INITIALLY START IN LOW SEGMENT
023 %HISEG==0 ;START AT 0 RELATIVE TO HIGH SEG ORIGIN
024 ] ;END OF IFN D10
025
026 002 026 IFN ITS, IFDEF .SBLK, .SBLK ;EVENTUALLY FLUSH "IFDEF .SBLK"
027
028
029 .YSTGWD ;STORAGE WORDS ARE OKAY NOW
030
031
032
033 FIRSTLOC:
034
035 005 005 IFN D10,[
036 HILOC==.+400000 ;HISEG STARTS AT 400000
037 ;;; FOR DEC-10, FIRSTLOC AS LOADED WITH RELOCATION MUST BE
038 ;;; STDLO+M*SEGSIZ
039 ;;; AND SIMILARLY HILOC WHEN LOADED MUST BE
040 ;;; STDHI+N*SEGSIZ
041 ;;; FOR INTEGRAL M AND N. INIT WILL ENFORCE THIS IN ORDER
042 ;;; TO PRESERVE SEGMENT BOUNDARIES CORRECTLY.
043 ;;; CURSTD IS THE STDXX FOR WHICHEVER IS THE CURRENT SEGMENT.
044 STDLO==140 ;SIZE OF JOB DATA AREA
045 STDHI==10 ;VESTIGIAL JOB DATA AREA
046 011 044 CURSTD==STDLO .SEE $LOSEG
047 ] ;END OF IFN D10
048 005 006 IFN ITS+D20,[
049 STDLO==0
050 STDHI==0
051 CURSTD==0
052 ] ;END OF IFN ITS+D20
053
FIRST LOCATIONS, UUO AND INTERRUPT VECTORS LISP.393[MAC,LSP] 01/17/78 Page 11.1
054 10% BZERSG==0 ;BEGINNING OF "ZERO" SEGMENT(S)
055 011 033 10$ BZERSG==FIRSTLOC-STDLO
056
057
058 LOC 41
059 022 058 JSR UUOH ;UUO HANDLER
060 002 030 10X WARN [TENEX INTERRUPT VECTOR?]
061
062 011 033 LOC FIRSTLOC
063 209 011 JRST GOINIT
064
065 LISPSW: ALLOC ;ALLOC CLOBBERS TO BE "LISP"
FIRST LOCATIONS, UUO AND INTERRUPT VECTORS LISP.393[MAC,LSP] 01/17/78 Page 12
001
002 002 026 IFN ITS,[
003 TWENTY==:20 ;VARIOUS PLACES OFFSET FROM TWENTY ARE USED BY DDT
004 012 003 THIRTY==:TWENTY+10 ;RECALL THAT THE LEFT HALF OF .40ADDR IS THE ".20ADDR"
005 ;;; ADDRESSES IN THE 20 BLOCK, SWIPED FROM DDT ORDER
006 ;;; 25 HOLDS "." DURING A USER TYPEOUT INSTRUCTION
007 ;;; 26 CONDITIONAL BREAKPOINT INSTRUCTION
008 ;;; 27-30 .BREAK 16,'S FOR RETURNING FROM 26
009 ;;; 31 INSTRUCTION FOR BREAKPOINT WHICH DIDN'T BREAK
010 ;;; 32-33 JRST'S TO PROGRAM FROM 31, OR DATA FOR INSTRUCTION IN 31
011 ;;; 34 INSTRUCTION BEING }X'D
012 184 007 .SEE MEMERR
013 .SEE UUOGL2
014 ;;; 35-36 .BREAK 16,'S FOR RETURNING FROM 34
015 184 062 .SEE $XLOST
016 .SEE UUOGL2
017 ;;; 37 HOLDS }Q DURING A USER TYPEOUT INSTRUCTION
018 142 020 .SEE PSYM1
019
020
021 FORTY: 0 ;.40ADDR USER VARIABLE POINTS HERE
022 012 033 JSR UUOGLEEP ;SYSTEMIC UUO HANDLER
023 020 015 Q% JSR INT ;SYSTEMIC INTERRUPT HANDLER
024 181 046 Q$ -LINTVEC,,INTVEC ;SYSTEMIC INTERRUPT HANDLER
025
026 ;;; THAT'S SYSTEMIC, NOT NECESSARILY SYSTEMATIC!!!
027
028 ;;; ITS PASSES THE BUCK TO THE USER ON UUO'S 0 AND 50-77.
029 ;;; THEY TRAP THROUGH THE .40ADDR, NOT NECESSARILY 40;
030 ;;; SINCE LISP TREATS THESE AS ERRORS, WE CAN AFFORD TO SAVE
031 ;;; THE JPC AND OTHER GOODIES HERE.
032
033 UUOGLEEP: 0
034 012 037 .SUSET [.RJPC,,JPCSAV]
035 209 011 JRST UUOGL1
036
037 JPCSAV: 0
038 ] ;END OF IFN ITS
SFX HACKERY LISP.393[MAC,LSP] 01/17/78 Page 13
001
002 SUBTTL SFX HACKERY
003
004 ;;; SFX MACRO TELLS WHERE A LONG PIECE OF SEMI-CRITICAL (MAY BE QUIT
005 ;;; OUT OF, BUT MUST NOT PERMIT USER INTERRUPTS IN) CODE MAY BE MUNGED
006 ;;; IF INTERRUPTED IN THE MIDDLE SO THAT WHEN DONE IT WILL RETURN TO
007 ;;; THE INTERRUPT HANDLER. SUCH CODE INCLUDES ARRAY SUBSCRIPT
008 ;;; COMPUTATIONS (SINCE AN INTERRUPT COULD DISPLACE THE ARRAY)
009 ;;; AND ALL CODE WHICH MODIFIES THE SPECIAL PDL.
010
011 NSFC==0 ;COUNTER FOR MACRO SFX
012 .XCREF NSFC
013
014 005 005 IFN D10,[
015
016 DEFINE SFX A/
017 011 033 SFSTO \.-FIRSTLOC,\NSFC,[A]
018 013 011 NSFC==NSFC+1
019 A
020 TERMIN
021
022 DEFINE SFSTO PT,NM,IN
023 DEFINE ZZM!NM
024 011 033 FIRSTLOC+PT
025 TERMIN
026 DEFINE ZZN!NM
027 IN
028 TERMIN
029 TERMIN
030
031 ] ;END OF IFN D10
032
033
034 002 026 IFN ITS,[
035
036 DEFINE SFX A/
037 013 022 SFSTO \.,\NSFC,[A]
038 013 011 NSFC==NSFC+1
039 A
040 TERMIN
041
042 DEFINE SFSTO PT,NM,IN
043 DEFINE ZZM!NM
044 PT
045 TERMIN
046 DEFINE ZZN!NM
047 IN
048 TERMIN
049 TERMIN
050
051 ] ;END OF IFN ITS
052
053
SFX HACKERY LISP.393[MAC,LSP] 01/17/78 Page 13.1
054 ;;; THE ZZM AND ZZN MACROS ARE EXPANDED AT SFXTBL (Q.V.)
SFX HACKERY LISP.393[MAC,LSP] 01/17/78 Page 14
001
002 ;;; **** ALL USES OF THE SFX MACRO MUST APPEAR ON THIS PAGE ****
003
004 SFXPRO
005 UNBND2: MOVE TT,(SP)
006 014 066 MOVEM TT,SPSV ;ABOUT LOADING TT WITH SPSV, SEE UNBIND
007 020 053 MOVE TT,UNBND3
008 013 016 SFX POPJ P,
009
010 014 066 ABIND3: PUSH SP,SPSV
011 013 016 SFX POPJ P,
012
013 064 009 SETXIT: SUB SP,R70+1
014 209 011 SFX JRST (T)
015
016 014 066 SPECX: PUSH SP,SPSV
017 209 011 SFX JRST (T)
018
019
020 AYNVSFX: ;XCT'ED BY AYNVER
021 013 016 SFX %WTA (D)
022
023 1DIMS: JSP T,AYNV1 ;1-DIM S-EXP ARRAYS COME HERE
024 071 024 ARYGET: ROT R,-1 ;COMMON S-EXP ARRAY ACCESS ROUTINE
025 071 024 ADDI TT,(R)
026 014 030 ARYGT4: JUMPL R,ARYGT8
027 HLRZ A,(TT)
028 013 016 SFX POPJ P,
029
030 ARYGT8: HRRZ A,(TT)
031 013 016 SFX POPJ P,
032
033
034 1DIMF: JSP T,AYNV1 ;1-DIM FULLWORD ARRAYS COME HERE
035 071 024 ANYGET: ADDI TT,(R) ;COMMON FULLWORD ARRAY ACCESS ROUTINE
036 MOVE TT,(TT)
037 013 016 SFX POPJ P,
038
039
040 002 069 IFN DBFLAG+CXFLAG,[
041 1DIMD: JSP T,AYNV1 ;1-DIM DOUBLEWORD ARRAYS COME HERE
042 071 024 ADYGET: LSH R,1 ;COMMON DOUBLEWORD ARRAY ACCESS ROUTINE
043 071 024 ADDI TT,(R)
044 181 046 KA MOVE D,1(TT)
045 KA MOVE TT,(TT)
046 KIKL DMOVE TT,(TT)
047 013 016 SFX POPJ P,
048 ] ;END OF IFN DBFLAG+CXFLAG
049
050
051 005 046 IFN DXFLAG,[
052 1DIMZ: JSP T,AYNV1 ;1-DIM FOUR-WORD ARRAYS COME HERE
053 071 024 AZYGET: LSH R,2 ;COMMON FOUR-WORD ARRAY ACCESS ROUTINE
SFX HACKERY LISP.393[MAC,LSP] 01/17/78 Page 14.1
054 071 024 ADDI TT,(R)
055 071 024 KA MOVE R,(TT)
056 KA MOVE F,1(TT)
057 181 046 KA MOVE D,3(TT)
058 KA MOVE TT,2(TT)
059 071 024 KIKL DMOVE R,(TT)
060 KIKL DMOVE TT,2(TT)
061 013 016 SFX POPJ P,
062 ] ;END OF IFN DXFLAG
063
064 NOPRO
065
066 SPSV: 0 ;IMPORTANT TO SPECPDL BINDINGS
067 224 005 Q% .SEE INTW0
068 227 015 Q$ .SEE IWAIT
069
070 ;;; **** THERE MUST BE NO MORE USES OF THE MACRO SFX BEYOND HERE ****
071 013 022 EXPUNGE SFX SFSTO
INTERRUPT FLAGS AND VARIABLES LISP.393[MAC,LSP] 01/17/78 Page 15
001
002 SUBTTL INTERRUPT FLAGS AND VARIABLES
003
004 ;;; INTFLG INDICATES WHETHER IN INTERRUPT IS PENDING:
005 ;;; 0 => NO INTERRUPT
006 ;;; -1 => USER INTERRUPT PENDING (STACKED IN INTAR)
007 ;;; -2 => ↑X QUIT PENDING, DON'T RESET TTY
008 ;;; -3 => ↑G QUIT PENDING, DON'T RESET TTY
009 ;;; -6 => ↑X QUIT PENDING, DO RESET TTY
010 ;;; -7 => ↑G QUIT PENDING, DO RESET TTY
011
012 INTFLG: 0
013
014 ;;; MAY NOT ↑G/↑X QUIT OR ALLOW USER INTERRUPTS IF NOQUIT NON-ZERO
015 ;;; NON-ZERO IN LH MEANS GC IN PROGRESS; IMPLIES
016 ;;; PDL POINTERS AND NIL MAY BE CLOBBERED
017 ;;; NON-ZERO ONLY IN RH MEANS PDL POINTERS AND NIL ARE OK
018
019 NOQUIT: 0
020
021 ;;; MAY NOT ALLOW "REAL TIME" INTERRUPTS (CLOCK AND TTY) WHEN
022 ;;; UNREAL IS NON-ZERO. MUNGED BY THE FUNCTION NOINTERRUPT.
023 ;;; 0 => ALL INTERRUPTS OKAY
024 ;;; -1 => NO INTERRUPTS OKAY
025 ;;; 'TTY => ALARMCLOCK OKAY, TTY NOT OKAY
026 UNREAL: 0
027
028 002 048 IFE QIO,[
029 QITC: 0 ;PLACES FOR VARIOUS INTERRUPT-TYPE GUYS TO SAVE ACS
030 QITD: 0
031 QITR: 0
032 ] ;END OF IFE QIO
033
034 Q$ ERRSVD: 0 .SEE ERRBAD
035
036 ;;; INTERRUPT MASK IS ALWAYS INITIALIZED FROM THIS WORD.
037 ;;; FOR ITS, THIS IS THE .MASK (AND .MSK2) WORDS.
038 ;;; FOR TOPS10 AND CMU, THIS IS THE APRENB WORD.
039 ;;; FOR D20, THIS IS THE
040 ;;; DEPOSITING DBGMSK INTO IT BEFORE STARTUP CAN AID DEBUGGING.
041 ;;; FOR ITS AND D20, IMPURE LISPS WILL HAVE DEBUG MASKS IN THESE
042 ;;; LOCATIONS; THE PURIFY ROUTINE INSTALLS THE STANDARD MASKS.
043 147 006 .SEE PURIFY
044 009 048 .SEE DBGMSK
045
046 009 047 IMASK: STDMSK ;INTERRUPT MASK WORD
047 181 032 Q$ IT$ IMASK2: STDMS2 ;ITS HAS TWO INTERRUPT MASKS
048
049
050 LFAKP==5 ;MUST BE LONG ENOUGH FOR USES BY
051 LFAKFXP==6 ; PDLOV, ERINIT, AND PURIFY
052 015 050 FAKP: BLOCK LFAKP ;FAKE REGPDL, FOR USE BY PDLOV AND ERINIT
053 015 051 FAKFXP: BLOCK LFAKFXP ;FAKE FIXPDL, FOR USE BY PDLOV AND ERINIT
INTERRUPT FLAGS AND VARIABLES LISP.393[MAC,LSP] 01/17/78 Page 15.1
054
055 002 048 IFE QIO,[
056 WAITFL: 0 ;NON-ZERO => INTWAIT IS LETTING AN SFXPRO'ED ROUTINE FINISH
057 WAITA: 0 ;A TEMPORARY FOR INTWAIT
058 WAITD2: 0 ;USED BY WAIT TO SAVE .DF2
059 ] ;END OF IFE QIO
060
061 ;;; IF NON-ZERO, THIS CONTAINS THE ADDRESS OF A USER-SUPPLIED
062 ;;; INTERRUPT PROCESSOR. THE LISP SYSTEM INTERRUPT HANDLER
063 ;;; WILL GIVE IT ANY INTERRUPT LISP DOESN'T PROCESS ITSELF. SEE INT0.
064
065 UPIINT: 0
ENTRIES TO VARIOUS ROUTINES CALLED BY JSR LISP.393[MAC,LSP] 01/17/78 Page 16
001
002 SUBTTL ENTRIES TO VARIOUS ROUTINES CALLED BY JSR
003
004 UISTAK: 0 ;STACK UP (ACTUALLY, QUEUE) A USER INTTERRUPT
005 192 012 JRST UISTK1
006
007 002 048 IFE QIO,[
008 INTWAIT: 0 ;CHECK TO SEE IF USER INTERRUPT OKAY NOW.
009 224 005 JRST INTW0
010
011 SPWR: 0 ;"SPECPDL WINNING RETURN" USED BY INTWAIT TO
012 225 005 JRST SPWR0 ; KEEP SP CONSISTENT. SEE ALSO THE SFX MACRO.
013
014 CNTROL: 0 ;PROCESS A CONTROL CHARACTER.
015 202 007 JRST CNTRL1 ;ASCII CODE IS IN ACCUMULATOR A.
016
017 005 005 IFE D10,[
018 PDLHAK: 0 ;FIGURE OUT WHICH PDL OVERFLOWED AND FIX IT.
019 209 011 JRST PDLH0 ;IF A NON-ZERO, HAS ADDRESS OF PDL POINTER.
020 ] ;END OF IFE D10
021 ] ;END OF IFE QIO
022
023 GCRSR: 0 ;GC RESTORE. CLEANS UP JUST BEFORE AN
024 209 011 JRST GCRSR0 ; ABNORMAL EXIT (GCEND IS NORMAL EXIT).
025
026 005 006 IFN ITS+D20,[
027 PDLSTH: 0 ;"PDL ST HACK". GETS A NEW PAGE FOR A PDL,
028 209 011 JRST PDLST0 ; AND UPDATES ST AND GCST APPROPRIATELY.
029
030 005 006 IFN D20,[
031 PDLSTA: 0 ;TEMPS FOR SAVING ACS
032 PDLSTB: 0
033 PDLSTC: 0
034 ] ;END OF IFN D20
035 ] ;END OF IFN ITS+D20
036
037 002 039 IFN MOBIOF,[
038 CLZDIS: 0 ;CLOSE THE DIS DEVICE
039 209 011 JRST CLZDS1
040
041 DISLEEP: 0 ;SLEEP AND WAIT FOR DISPLAY SLAVE
042 209 011 JRST DISLP1
043 DISLP2: 0 ;A COUNTER FOR WAITING OUT REQUESTS
044 ] ;END OF IFN MOBIOF
NEWIO I/O CHANNEL ALLOCATION TABLE LISP.393[MAC,LSP] 01/17/78 Page 17
001
002 002 048 IFN QIO,[
003
004 SUBTTL NEWIO I/O CHANNEL ALLOCATION TABLE
005
006 ;;; ENTRIES:
007 ;;; 4.9 => CHANNEL IS LOCKED FOR A PARTICULAR PURPOSE
008 ;;; 1.1-2.9 => ADDRESS OF FILE ARRAY SAR
009 ;;; IF AN ENTRY IS NON-ZERO BUT ITS FILE ARRAY SAR'S
010 ;;; TTS.CL BIT IS SET, THE CHANNEL MAY BE DE-ALLOCATED.
011 ;;; THIS ORDINARILY HAPPENS ONLY ON A QUIT OUT OF $OPEN.
012 ;;; CHANNEL 0 (TMPC) IS PERMANENTLY LOCKED FOR USE OF THE ERR
013 ;;; DEVICE, FOR UPROBE, ETC. NOTE THAT ITS PUTS .OPEN
014 ;;; AND .CALL FAILURE CODES ON CHANNEL 0 ARBITRARILY.
015
016 005 005 IFN ITS+D10, LCHNTB==:20 ;NUMBER FIXED BY OPERATING SYSTEM
017 005 006 IFN D20, MAYBE LCHNTB==:40 ;THIS NUMBER IS ARBITRARY, BUT LESS THAN NUMBER OF JFNS
018
019 CHNTB:
020 OFFSET -.
021 TMPC:: 400000,,NIL ;FIXED TEMPORARY CHANNEL
022 017 016 IFGE LCHNTB-., BLOCK LCHNTB-.
023 .ELSE WARN [TOO MANY FIXED I/O CHANNELS]
024 OFFSET 0
025
026
027 ;;; DEC-10 I/O BUFFER HEADERS (MUST REMAIN FIXED IN CORE)
028 ;;; THEY ARE NAMED BFHD0, BFHD1, ..., BFHD17.
029
030 005 005 IFN D10, REPEAT LCHNTB, CONC BFHD,\.RPCNT,: BLOCK 3
031
032
033
034 DPAGEL: 60. ;INITIAL DEFAULT PAGEL
035 DLINEL: 70. ;INITIAL DEFAULT LINEL
036
037 002 049 IFN JOBQIO,[
038 LJOBTB==10 ;EIGHT INFERIOR PROCEDURES
039 017 038 JOBTB: BLOCK LJOBTB
040 ] ;END OF IFN JOBQIO
INITIAL TTY INPUT FILE ARRAY LISP.393[MAC,LSP] 01/17/78 Page 18
001
002 ;;; IFN QIO
003
004 SUBTTL INITIAL TTY INPUT FILE ARRAY
005
006 018 010 -F.GC,,TTYIF2 ;GC AOBJN POINTER
007 TTYIF1: JSP TT,1DIMS
008 TTYIFA ;POINTER BACK TO SAR
009 0 ;ILLEGAL FOR USER TO ACCESS - SAY DIMENSION IS ZERO
010 TTYIF2:
011 OFFSET -.
012 FI.EOF:: NIL ;EOF FUNCTION (??)
013 FI.BBC:: 0,,NIL ;BUFFERED BACK CHARS
014 FI.BBF:: NIL ;BUFFERED BACK FORMS
015 TI.BFN:: QTTYBUF ;PRE-SCAN FUNCTION
016 FT.CNS:: TTYOFA ;ASSOCIATED TTY OUTPUT FILE
017 REPEAT 3, 0 ;UNUSED SLOTS
018 F.MODE:: FBT.CM,,2 ;MODE (ASCII TTY IN SINGLE)
019 F.CHAN:: -1 ;CHANNEL # (INITIALLY ILLEGAL)
020 20$ F.JFN:: .PRIIN ;JFN (FOR D20 ONLY)
021 20% 0
022 F.FLEN:: -1 ;WE EXPECT RANDOM ACCESS TO BE IMPOSSIBLE
023 F.FPOS:: 0 ;FILE POSITION
024 REPEAT 3, 0 ;UNUSED SLOTS
025 005 005 IFN ITS+D10,[
026 004 046 F.DEV:: SIXBIT \TTY\ ;DEVICE
027 IT$ F.SNM:: 0 ;SNAME (FILLED IN)
028 10$ F.PPN:: 0 ;PPN (FILLED IN)
029 F.FN1::
030 IT$ SIXBIT \.LISP.\ ;FILE NAME 1
031 220 009 10$ SIXBIT \LISP\
032 F.FN2::
033 IT$ SIXBIT \INPUT\ ;FILE NAME 2
034 10$ SIXBIT \IN\
035 F.RDEV:: BLOCK 4 ;TRUE FILE NAMES
036 ] ;END OF IFN ITS+D10
037 005 006 IFN D20,[
038 004 046 F.DEV:: ASCII \TTY\
039 ] ;END OF IFN D20
040 018 010 LOC TTYIF2+LOPOFA
041 002 029 IFN ITS+D20+SAIL,[
042 TI.ST1::
043 IT$ STTYW1 ;TTY STATUS WORDS
044 20$ CCOC1
045 SA$ SACTW1
046 TI.ST2::
047 IT$ STTYW2
048 20$ CCOC2
049 SA$ SACTW2
050 SA$ TI.ST3:: SACTW3
051 SA$ TI.ST4:: SACTW4
052 SA% BLOCK 2
053 ] ;END OF IFN ITS+D20+SAIL
INITIAL TTY INPUT FILE ARRAY LISP.393[MAC,LSP] 01/17/78 Page 18.1
054 .ELSE BLOCK 4
055 019 040 0 .SEE ATO.LC
056 AT.CHS:: 0 ;CHARPOS
057 AT.LNN:: 0 ;LINENUM
058 AT.PGN:: 0 ;PAGENUM
059 BLOCK 10
060 LONBFA:: BLOCK 10
061 ;INTERRUPT FUNCTIONS
062 FB.BUF::
063 NIL,,NIL ;↑@ ↑A
064 035 006 QCN.BB,,IN0+↑C ;↑B ↑B-BREAK ↑C GC STAT OFF
065 181 046 IN0+↑D,,NIL ;↑D GC STAT ON ↑E
066 NIL,,IN0+↑G ;↑F ↑G HARD QUIT
067 REPEAT 3, NIL,,NIL ;↑H-↑M (FORMAT EFFECTORS)
068 NIL,,NIL ;↑N ↑O
069 NIL,,NIL ;↑P ↑Q
070 071 024 IN0+↑R,,IN0+↑W ;↑R UWRITE ON? ↑S ↑W INT, ↑V MACRO
071 IN0+↑T,,NIL ;↑T UWRITE OFF? ↑U
072 IN0+↑V,,IN0+↑W ;↑V TTY ON ↑W TTY OFF
073 IN0+↑X,,NIL ;↑X SOFT QUIT ↑Y
074 IN0+↑Z,,NIL ;↑Z GO TO DDT } <ALTMODE>
075 NIL,,NIL ;↑\ CONTROL RIGHT-BRACKET
076 NIL,,NIL ;↑↑ ↑←
077 018 062 REPEAT <NASCII/2>-<.-FB.BUF>, NIL,,NIL ;ALL OTHERS INITIALLY UNUSED
078
079 OFFSET 0
INITIAL TTY OUTPUT FILE ARRAY LISP.393[MAC,LSP] 01/17/78 Page 19
001
002 ;;; IFN QIO
003
004 SUBTTL INITIAL TTY OUTPUT FILE ARRAY
005
006 019 010 -F.GC,,TTYOF2 ;GC AOBJN POINTER
007 TTYOF1: JSP TT,1DIMS
008 TTYOFA ;POINTER BACK TO SAR
009 0 ;USER MAY NOT ACCESS, SO SAY DIMENSION IS ZERO
010 TTYOF2:
011 OFFSET -.
012 FO.EOP:: QTTYMOR ;END OF PAGE FUNCTION
013 REPEAT 3, 0
014 FT.CNS:: TTYIFA ;STATUS TTYCONS
015 REPEAT 3, 0
016 F.MODE:: FBT.CM,,3 ;MODE (ASCII TTY OUT SINGLE)
017 F.CHAN:: -1 ;CHANNEL # (INITIALLY ILLEGAL)
018 20$ F.JFN:: .PRIOU ;JFN
019 20% 0
020 F.FLEN:: -1 ;NOT RANDOMLY ACCESSIBLE
021 F.FPOS:: 0 ;FILE POSITION
022 REPEAT 3, 0
023 005 005 IFN ITS+D10,[
024 004 046 F.DEV:: SIXBIT \TTY\ ;DEVICE
025 IT$ F.SNM:: 0 ;SNAME (FILLED IN)
026 10$ F.PPN:: 0 ;PPN (FILLED IN)
027 F.FN1::
028 IT$ SIXBIT \.LISP.\ ;FILE NAME 1
029 220 009 10$ SIXBIT \LISP\
030 F.FN2::
031 IT$ SIXBIT \OUTPUT\ ;FILE NAME 2
032 10$ SIXBIT \OUT\
033 F.RDEV:: BLOCK 4 ;TRUE FILE NAMES
034 ] ;END OF IFN ITS+D10
035 005 006 IFN D20,[
036 004 046 F.DEV:: ASCII \TTY\
037 ] ;END OF IFN D20
038 019 010 LOC TTYOF2+LOPOFA
039 BLOCK 4
040 ATO.LC:: 0 ;LINEFEED/SLASH FLAG
041 AT.CHS:: 0 ;CHARPOS
042 AT.LNN:: 0 ;LINENUM
043 AT.PGN:: 0 ;PAGENUM
044 FO.LNL:: 71. ;LINEL
045 FO.PGL:: 200000,, ;PAGEL
046 FO.RPL:: 24. ;"REAL" PAGEL
047 BLOCK 5
048 LONBFA::
049 OFFSET 0
050
051 ] ;END OF IFN QIO
SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 20
001
002 SUBTTL SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT
003
004 ;;; DONT ALLOW USER INTERRUPTS WHILE:
005 ;;; (1) NOQUIT IS NON-ZERO - THIS PROTECTS GC,
006 ;;; RETSP, SUBLIS, AND OTHERS.
007 ;;; (2) INHIBIT IS NON-ZERO - THIS PROTECTS
008 ;;; MANY AREAS OF SEMI-CRITICAL CODE.
009 ;;; (CF. LOCKI AND UNLOCKI MACROS)
010 ;;; (3) UNREAL IS NON-ZERO (DEPENDS ONEXACT VALUE)
011 ;;; - THIS IS FOR THE NOINTERRUPT FUNCTION
012
013 SWS::
014 002 048 IFE QIO,[
015 INT: 0
016 IPCLOK: 0 ;PC LOCATION AT TIME OF INTERRUPT
017 177 016 IT$ JRST INT0
018 INTSV: 0 ;INTERRUPT REGISTER SAVED
019 RDOBCT: 0 ;STALLMAN'S HAC TO STOP RDIN0 WHILE READING FROM TAPE
020 ] ;END OF IFE QIO
021
022 ;;; THE FOLLOWING STUFF IS SAVED WHEN AN "ERRSET FRAME" IS CREATED.
023 ;;; NOT ONLY ERRSET, BUT ALSO CATCH AND READ NEED TO DO THIS.
024 ;;; INTERPRETED PROGS CREATE A SORT OF HALF-ASSED FRAME.
025 ;;; BEWARE! THE COMPILER DEPENDS ON KNOWING THE LENGTH OF
026 ;;; THE ERRSET FRAME AS A CONSTANT PARAMETER.
027
028 ERRTN: 0 ;PDL RESTORATION FOR ERRSET
029 CATRTN: 0 ;PDL RESTORATION FOR CATCH OF A THROW
030 EOFRTN: 0 ;PDL RESTORATION ON E-O-F TRAPOUT
031 PA4: 0 ;PDL RESTORATION ON GO OR RETURN
032 INHIBIT: 0 ;NON-ZERO => INHIBIT (DELAY) USER INTERRUPTS
033 ERRSW: -1 ;0 MEANS NO PRINT ON ERROR DURING ERRSET
034 Q% RRDF: -1 ;LEVEL OF READ: -1=>NONE, 0=>SIMPLE, 1=>RECURSIVE
035 Q$ BFPRDP: 0 ;LH: FUNCTION WHICH WANTS TTY PRE-SCAN
036 ; (READ, READLINE)
037 ; TYI FOR ACTIVATION AND CURSORPOS
038 ; CLEVERNESS, BUT NO PRE-SCAN
039 ; NIL FOR NO CLEVERNESS AT ALL
040 ;RH: -1 IF WITHIN READ
041 CATID: NIL ;CATCH IDENTIFICATION TAG
042 020 028 LEP1==.-ERRTN ;***** LENGTH OF SOME OF ERRSET PUSH
043 057 038 .SEE ERSTP
044
045
046 UIRTN: 0 ;NON-ZERO => PDL LOC OF MOST RECENT USER INT FRAME
047 197 011 .SEE UINT0
048
049 RSXTB: (A) ;POINTER TO READ SYNTAX TABLE, INDEXED BY A
050
051 GCD.A: .SEE GCDBB
052 094 012 PNMK1: .SEE PDLNMK ;SAVE TT
053 049 033 UNBND3: .SEE UNBIND ;SAVE TT
SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 20.1
054 052 005 SIXMK2: 0 .SEE SIXMAK
055
056 115 088 SAVMAR: .SEE SUSP14 ;NEEDN'T BE IN SWS, BUT WHO CARES?
057 GCD.B: .SEE GCDBB
058 136 028 AUNBD: .SEE AUNBIND ;SAVES D FOR AUNBIND
059 EXP.S: .SEE EXP ;REMEMBERS SIGN OF ARG
060 ATAN.S: .SEE ATAN ;SAVES SIGNS OF ARGS <X,,Y>
061 UNMTMP: ;UNAME TEMP
062 FPTEM: ;PSYM WANTS THIS TO BE SAME AS PCNT!!!
063 064 031 IFLT9: .SEE IFLOAT ;D SAVED HERE
064 EQLP: 0 ;PDL POINTER UPON ENTRY TO EQUAL
065 088 004 .SEE EQUAL
066
067 GCD.C: .SEE GCDBB
068 ATAN.X: .SEE ATAN ;TEMPORARY X VALUE
069 GWDCNT: 0
070
071 GCD.D: .SEE GCDBB
072 ATAN.Y: .SEE ATAN ;TEMPORARY Y VALUE
073 GWDORG: 0 ;ORIGIN OF LAPPIFICATION - GWDRG1 IS GWDORG-1
074
075 GWDRG1: 0
SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 21
001
002 EXPL5: 0 ;TEMP FOR EXPLODE
003
004 GCD.UH: .SEE GCDBB
005 BKTRP: .SEE BAKTRACE
006 152 043 EV0B: .SEE EVAL
007 FLAT1: .SEE FLATSIZE
008 091 004 MEMV: 0 .SEE MEMBER
009
010 UAPOS: ;-1 => UWRITE, >=0 => UAPPEND .ACCESS POS
011 GCD.VH: .SEE GCDBB
012 LPNF: ;-1 MEANS NOT A LONG PNAME (FITS IN PNBUF)
013 106 004 .SEE RINTERN
014 AUNBR: 0 ;SAVES R FOR AUNBIND
015 DLTC: 0 ;# OF TIMES DELETE/DELQ SHOULD REMOVE ITEM
016 092 002 .SEE DELQ
017
018 RINF:
019 APFNG1:
020 TABLU1: 0
021
022 AUNBF: ;SAVES F FOR AUNBIND
023 002 041 IFE BIGNUM,[
024 MNMX0: ;"MIN" INSTRUCTION
025 GRESS0: 0 ;"GREATERP" INSTRUCTION
026 ] ;END OF IFE BIGNUM
027 002 041 IFN BIGNUM,[
028 GRESS0: 0 ;"MIN" AND"GREATERP" INSTRUCTION
029 209 011 CFAIL: JRST . ;TRANSFER ON FAILURE
030 209 011 CSUCE: JRST . ;TRANSFER ON SUCCEED
031 ] ;END OF IFN BIGNUM
032
033 IT$ IOST: .STATUS 00,A
034 002 026 IFN ITS, SYSCL8:
035 BACTYF: 0 ;ZERO ON FIRST LOOP THROUGH BACTRACE.
036 181 046 BOOLI: SETZB D,TT ;BOOLEAN INSTRUCTION FOR BOOLE
037
038 002 051 IFN USELESS, PRINLV: ;<CURRENT PRINT LEVEL>-1
039 PLUS0: 0 ;TYPE - QFIXNUM OR QFLONUM
040
041 002 041 IFE BIGNUM,[
042 181 046 PLUS3: ADD D,TT
043 181 046 PLUS6: FAD D,TT ;FLOAT-POINT INSTRUCTION FOR ARITH GENERATOR
044 ] ;END OF IFE BIGNUM
045
046 002 051 IFN USELESS, ABBRSW: ;KIND OF STUFF DESIRED FROM PRINT0:
047 ; - => ONLY ABBREV STUFF
048 ; 0 => ONLY NON-ABBREV STUFF
049 ; + => BOTH (DISTINGUISHED BY TYOSW)
050 PLUS8: 0 ;<N,,N> WHERE THERE ARE N ARGS
051 RM4: 0
052 002 051 IFN USELESS, PRPRCT: ;PRINT'S PARENS COUNTS (LEFT,,RIGHT)
053 SWNACK: 0 ;USED FOR WNA CHECKING IN STATUS
SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 21.1
054 209 011 JRST STAT1
055 002 051 IFN USELESS, TYOSW: 0 ;NORMALLY ZERO - TELLS TYO TYPE OF CHAR
056 ; + => CHAR IS FOR FILES ONLY
057 ; - => CHAR IS FOR TTY ONLY
058 ; 0 => CHAR IS FOR BOTH FILES AND TTY
059 RDBKBF: 0 ;OCCASIONALLY, A BREAK CHARA HAS TO BE BUFFERED BACK
060 RDBKC: 0 ;SAVED BREAK CHARACTER, ON EXIT FROM RDCHAR
061 RDNSV: 0 ;SAVED NUMBER (BEFORE DECIMAL-OR-NOT IS DECIDED)
062 RDDSV: 0 ;SAVED VALUE OF # OF DIGITS TO RIGHT OF DECIMAL POINT
063 RDIBS: 0 ;NUMERIC IBASE DURING READING
064 002 051 IFN USELESS, RDROMP: 0 ;ROMANP - ARE ROMAN NUMERALS OK?
065 RDINCH: 0 ;SOURCE OF CHARACTERS FOR READ
066 CORBP: 0 ;BYTE-POINTER FOR READ-SOURCE WHEN SOURCE IS BLOCK OF
067 ;ASCII OR SIXBIT STUFF IN CORE
068 MKNCH: 0 ;INSTRUCTIION FOR MAKNAM TO GET NEXT BYTE
SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 22
001
002 ;;; THE PNAME BUFFER IS USED FOR VARIOUS AND SUNDRY PURPOSES.
003 ;;; THE PRIMARY PURPOSE IS ACCUMULATING PRINT NAMES OF ATOMS.
004 106 004 .SEE RINTERN
005 ;;; IT IS ALSO USED FOR VALRET AND SUSPEND STRINGS,
006 113 004 .SEE VALRET
007 115 002 .SEE SUSPEND
008 ;;; JCL, NAMESTRINGS OF FILES (ESPECIALLY FOR D20 GTJFN JSYS),
009 .SEE 6BTNS
010 ;;; ERROR MESSAGE STRING PROCESSING,
011 205 024 .SEE ERRIOJ
012 ;;; AND SO ON. FOR SOME PURPOSES THIS BUFFER OVERLAPS THE BIGNUM TEMPS.
013 20% MAYBE LPNBUF==:10
014 20$ MAYBE LPNBUF==:50
015
016 022 019 PNBP: 440700,,PNBUF ;BYTE POINTER FOR PNAME BUFFER
017
018 MACOUT: 0
019 022 013 PNBUF: BLOCK LPNBUF
020 0 ;EXTRA WORD USED TO GUARANTEE THAT A STRING CAN BE MADE ASCIZ
021 022 019 JCLBF==:PNBUF+1 ;SINCE STATUS JCL MAY CALL INTERN ON A SCO
022 022 019 ATMBF==:PNBUF+1 ;DITTO INTERACTION BETWEEN PRINTA AND EXPLODE
023
024 002 041 IFN BIGNUM,[
025 REMFL: 0 ;REMAINDER FLAG
026 VETBL0: 0 ;DIVISION STUFF
027 DVS1: 0
028 DVS2: 0
029 DVSL: 0
030 DD1: 0
031 DD2: 0
032 DD3: 0
033 DDL: 0
034 NORMF: 0
035 QHAT: 0
036 BNMSV: 0
037 FACF: 0
038 FACD: 0
039 AGDBT: 0
040 YAGDBT: 0
041 TSAVE: 0
042 DSAVE: 0
043 RSAVE: 0
044 FSAVE: 0
045 NRD10FL: 0 ;NOT READING IN BASE 10. FLAG
046 ] ;END OF IFN BIGNUM
047 022 021 IFG JCLBF+24-., BLOCK JCLBF+24-. ;MUST HAVE AT LEAST 24 WDS
048 022 018 LVLRTS==:.-MACOUT ;LENGTH OF VALRET STRING BUFFER
049 022 021 LJCLBF==:.-JCLBF
050
051 002 048 IFE QIO,[
052 ERROR3: 0 ;PRINT OUT ERROR MESSAGE
053 209 011 JRST EROR3A
SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT LISP.393[MAC,LSP] 01/17/78 Page 22.1
054 ERROR4: 0 ;PRINT OUT FOR OTHER KINDS OF ERRORS
055 209 011 JRST EROR4A
056 ] ;END OF IFE QIO
057
058 UUOH: ;KEEP THIS UUO STUFF CONTIGIOUS SO THAT GC CAN SAVE IT.
059 ERROR: 0
060 205 006 JRST UUOH0
061 ERBDF: ;SOME RANDOM TEMP FOR UUO HANDLER
062 UUOFN: 0 ;POINTER TO FUNCTION DURING THE UUOH1 LOOP
063 UUTSV: 0
064 UUTTSV: 0
065 UURSV: 0
066 207 038 UUALT9: .SEE UUALT ;DOESN'T CONFLICT WITH UUPSV
067 UUPSV: 0
068 UUOBKG: 0 ;IF IN *RSET MODE, PUT STUFF ON PDL
069 022 058 LUUSV==:.-UUOH ;STUFF THAT NEEDS SAVING FOR THE UUO HANDLER
070 020 013 LSWS==:.-SWS ;TOTAL LENGTH OF SUPER-WRITABLE STUFF
071 208 014 JRST UUBKG1
072
073 ;;; ******** STUFF SAVED UPON USER INTERRUPT ENDS HERE ********
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 23
001
002 SUBTTL FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS
003
004 ;;; ********** FREE STORAGE LISTS **********
005
006 ;;; THESE ARE USED BY THE VARIOUS CONSERS TO ALLOCATE CELLS OF
007 ;;; THE VARIOUS FREE STORAGE SPACES. NEVER PUT ONE OF THESE IN
008 ;;; A MARKABLE AC (EXCEPT WITHIN A PROPERLY PROTECTED CONSER)!
009
010 ;;; CAUTION! MUST PRESERVE RELATIVE ORDERING OF
011 ;;; FFS,FFX,FFL,FFD,FFC,FFZ,FFB,FFY,FFH,FFA,FFY2
012 .SEE GC ;GARBAGE COLLECTOR
013
014 FFS: 0 ;LIST FREE STORAGE LIST
015 FFX: 0 ;FIXNUMS (AND PNAME AND BIGNUM WORDS)
016 FFL: 0 ;FLONUM WORDS LIST
017 131 052 DB$ FFD: SETZ ;DOUBLE-PRECISION FLONUMS
018 131 052 CX$ FFC: SETZ ;COMPLEX NUMBERS
019 131 052 DX$ FFZ: SETZ ;DOUBLE-PRECISION COMPLEX (DUPLEX)
020 BG$ FFB: 0 ;BIGNUM HEADERS
021 FFY: 0 ;SYMBOL (PNAME-TYPE ATOM) HEADERS
022 131 052 HN$ FFH: REPEAT HNKLOG, SETZ ;HUNKS
023 FFA: 0 ;SARS (ARRAY POINTERS)
024 023 014 NFF==:.-FFS ;NUMBER OF FF FROBS
025 FFY2: SY2ALC ;SYMBOL BLOCKS (EXPLICIT RETURN USED)
026 ;;; SIGN BIT IN FF- MEANS EXEMPT FROM 40-WORD MINIMUM RECLAIMED.
027 .SEE GCSWH1
028 .SEE AGC1Q
029 .SEE GCE0C5
030 .SEE GCE0C9
031 079 036 .SEE HUNK
032
033 ;;; PURE FREE STORAGE COUNTERS (NON-POSITIVE, RELATIVE TO EPFF- BELOW)
034 ;;; MUST PRESERVE RELATIVE ORDERING THROUGH NPFFY2
035 NPFFS: 0 ;LIST
036 NPFFX: 0 ;FIXNUM
037 NPFFL: 0 ;FLONUM
038 DB$ NPFFD: 0 ;DOUBLE
039 CX$ NPFFC: 0 ;COMPLEX
040 DX$ NPFFZ: 0 ;DUPLEX
041 BG$ NPFFB: 0 ;BIGNUM
042 0 ;NO PURE SYMBOLS
043 002 050 HN$ NPFFH: REPEAT HNKLOG, 0 ;HUNKS
044 0 ;NO PURE SARS
045 023 035 IFN .-NPFFS-NFF, WARN [NPFF- TABLE WRONG LENGTH]
046 NPFFY2: 0 ;SYMBOL BLOCKS
047
048 ;;; ADDRESS OF WORD ABOVE CURRENT PURE SEGMENT FOR EACH SPACE
049 ;;; MUST PRESERVE RELATIVE ORDERING THROUGH EPFFY2
050 EPFFS: 0 ;LIST
051 EPFFX: 0 ;FIXNUM
052 EPFFL: 0 ;FLONUM
053 DB$ EPFFD: 0 ;DOUBLE
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 23.1
054 CX$ EPFFC: 0 ;COMPLEX
055 DX$ EPFFZ: 0 ;DUPLEX
056 BG$ EPFFB: 0 ;BIGNUM
057 0 ;NO PURE SYMBOLS
058 002 050 HN$ EPFFH: REPEAT HNKLOG, 0 ;HUNKS
059 0 ;NO PURE SARS
060 023 050 IFN .-EPFFS-NFF, WARN [EPFF- TABLE WRONG LENGTH]
061 EPFFY2: 0 ;SYMBOL BLOCKS
062
063 008 004 EFVCS: BVCSG+NVCSG*SEGSIZ ;END OF CURRENT VC REGION (EFVCS+NFVCS=LAST USED VC)
064 008 009 NFVCP: NXVCSG/SGS%PG ;NUMBER OF EXTRA VC PAGES
065 FFVC: BFVCS ;VALUE CELL FREELIST (EXPLICIT RETURN USED)
066 ETVCFLSP: 0 .SEE GCMARK ;EVER-TOOK-VALUE-CELL-FROM-LIST-SPACE-P
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 24
001
002 ;;; GCMKL IS ARRANGED LIKE A PROPERTY LIST: THE "PROPERTY NAMES"
003 ;;; ARE SARS, IN DECREASING ORDER OF POSITION IN ARRAY SPACE,
004 ;;; AND THE "PROPERTY VALUES" ARE FIXNUMS DENOTING THE LENGTHS
005 ;;; OF THE ARRAYS. USED BY GC, RETSP, GRELAR, *ARRAY, AND OTHERS
006 ;;; TO KEEP TRACK OF ARRAYS. NOTE: THE INITIAL OBARRAY AND
007 ;;; READTABLE ARE NOT IN GCMKL SINCE THEY ARE NOT IN BPS.
008 GCMKL: IGCMKL
009
010 ;;; PROLIS IS AN ALIST USED TO PROTECT NON-ATOMIC READ-MACRO
011 ;;; FUNCTIONS FROM BEING GC'ED. EACH ITEM ON THE
012 ;;; ALIST IS OF THE FORM (FUN RDT . NUM) WHERE:
013 ;;; FUN IS THE FUNCTION TO BE PROTECTED
014 ;;; RDT IS THE SAR OF THE READTABLE CONCERNED
015 ;;; NUM IS A LISP NUMBER (GUARANTEED NLISP INUM)
016 ;;; <ASCII CHAR VALUE> FOR READ-MACRO FUNCTION
017 ;;; PROLIS IS UPDATED BY SSGCPRO AND SSGCREL.
018 PROLIS: NIL
019
020 ;;; VARIOUS RANDOM PARAMETERS FOR GARBAGE COLLECTOR.
021 ;;; MUST PRESERVE RELATIVE ORDER WITHIN GROUPS.
022
023 ;;; GCMIN PARAMETERS FOR EACH SPACE (FLONUM IFF LH NON-ZERO)
024 .SEE GCE0C0
025 MFFS: MINFFS ;LIST
026 MFFX: MINFFX ;FIXNUM
027 MFFL: MINFFL ;FLONUM
028 DB$ MFFD: MINFFD ;DOUBLE
029 CX$ MFFC: MINFFC ;COMPLEX
030 DX$ MFFZ: MINFFZ ;DUPLEX
031 BG$ MFFB: MINFFB ;BIGNUM
032 MFFY: MINFFY ;SYMBOL
033 002 050 HN$ MFFH: REPEAT HNKLOG, MINFFH ;HUNKS
034 MFFA: MINFFA ;SARS
035 024 025 IFN .-MFFS-NFF, WARN [MFF- TABLE WRONG LENGTH]
036
037 ;;; LENGTH OF FREELISTS <BEFORE,,AFTER>
038 .SEE GCP4B
039 NFFS: 0 ;LIST
040 NFFX: 0 ;FIXNUM
041 NFFL: 0 ;FLONUM
042 DB$ NFFD: 0 ;DOUBLE
043 CX$ NFFC: 0 ;COMPLEX
044 DX$ NFFZ: 0 ;DUPLEX
045 BG$ NFFB: 0 ;BIGNUM
046 NFFY: 0 ;SYMBOL
047 002 050 HN$ NFFH: REPEAT HNKLOG, 0 ;HUNKS
048 NFFA: 0 ;SARS
049 024 039 IFN .-NFFS-NFF, WARN [NFF- TABLE WRONG LENGTH]
050
051 002 026 IFN USELESS*QIO*ITS,[
052 GCWHO: 0 ;VALUE OF (STATUS GCWHO)
053 ;1.1 => DISPLAY MESSAGE DURING GC
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 24.1
054 ;1.2 => CLOBBER .WHO2 WITH GC STATISTICS
055 GCWHO1: 0 ;SAVED VALUES OF WHO-LINE VARIABLES DURING GC
056 GCWHO2: 0
057 GCWHO3: 0
058 ] ;IFN USELESS*QIO*ITS
059
060 GCACSAV: BLOCK NACS+1 ;MARKED ACS SAVED HERE
061 GCNASV: BLOCK 20-<NACS+1> ;UNMARKED ACS SAVED HERE
062 024 060 Q$ GCP=:GCACSAV+P
063 024 060 Q$ GCFLP=:GCACSAV+FLP
064 024 060 Q$ GCFXP=:GCACSAV+FXP ;TEST GCFXP FOR NON-ZERO TO DECIDE IF
065 024 060 Q$ GCSP=:GCACSAV+SP ; INSIDE GC (IMPLYING REAL PDL POINTERS ARE HERE)
066
067 PANICP: 0 ;-1 SAYS WE'RE CLOSE TO RUNNING OUT OF CELLS
068 GCMRKV: 0 ;NON-NIL MEANS MARK PHASE ONLY
069 GCTIM: 0 ;GC TIME
070 GCTM1: 0
071 022 069 GCUUSV: BLOCK LUUSV
072 IRMVF: 0 ;GCTWA REMOVAL OVERRIDE SWITCH
073 GCRMV: 0 ;WHETHER TO DO GCTWA REMOVAL
074 ARPGCT: 4 ;# OF PAGES TO GRAB FREELY FOR ARRAYS BEFORE GC
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 25
001
002 ;;; PARAMETERS RELEVANT TO MEMORY ALLOCATION.
003 ;;; MUST PRESERVE RELATIVE ORDERING OF MOST OF THIS STUFF.
004
005 ;USED BY GC TO HOLD EXACT CALCULATED INTEGRAL GCMINS
006 ZFFS: 0 ;LIST
007 ZFFX: 0 ;FIXNUM
008 ZFFL: 0 ;FLONUM
009 DB$ ZFFD: 0 ;DOUBLE
010 CX$ ZFFC: 0 ;COMPLEX
011 DX$ ZFFZ: 0 ;DUPLEX
012 BG$ ZFFB: 0 ;BIGNUM
013 ZFFY: 0 ;SYMBOL
014 002 050 HN$ ZFFH: REPEAT HNKLOG, 0 ;HUNK
015 ZFFA: 0 ;SARS
016 025 006 IFN .-ZFFS-NFF, WARN [ZFF- TABLE WRONG LENGTH]
017
018 .SEE SSPCSIZE ;SIZE OF EACH SWEEPABLE SPACE. USED TO CALCULATE PERCENTAGE RECLAIMED.
019 008 004 SFSSIZ: NIFSSG*SEGSIZ ;LIST
020 008 004 SFXSIZ: NIFXSG*SEGSIZ ;FIXNUM
021 008 004 SFLSIZ: NIFLSG*SEGSIZ ;FLONUM
022 DB$ SDBSIZ: 0 ;DOUBLE
023 CX$ SCXSIZ: 0 ;COMPLEX
024 DX$ SDXSIZ: 0 ;DUPLEX
025 008 004 BG$ SBNSIZ: NBNSG*SEGSIZ ;BIGNUM
026 008 004 SSYSIZ: NSYMSG*SEGSIZ ;SYMBOL
027 002 050 HN$ SHNSIZ: REPEAT HNKLOG, 0 ;HUNKS
028 008 004 SSASIZ: NSARSG*SEGSIZ ;SARS
029 025 019 IFN .-SFSSIZ-NFF, WARN [S--SIZ TABLE WRONG LENGTH]
030
031 ;SIZES OF SPACES BEFORE START OF GC. COPIED FROM SFSSIZ ET AL. AT START OF GC.
032 OFSSIZ: 0 ;LIST
033 OFXSIZ: 0 ;FIXNUM
034 OFLSIZ: 0 ;FLONUM
035 DB$ ODBSIZ: 0 ;DOUBLE
036 CX$ OCXSIZ: 0 ;COMPLEX
037 DX$ ODXSIZ: 0 ;DUPLEX
038 BG$ OBNSIZ: 0 ;BIGNUM
039 OSYSIZ: 0 ;SYMBOL
040 002 050 HN$ OHNSIZ: REPEAT HNKLOG, 0 ;HUNKS
041 OSASIZ: 0 ;SARS
042 025 032 IFN .-OFSSIZ-NFF, WARN [O--SIZ TABLE WRONG LENGTH]
043
044 ;SIZE FOR EACH SPACE BELOW WHICH TO GRAB NEW SEGMENTS FASTLY
045 .SEE SGCSIZE ; (I.E. WITHOUT DOING A WHOLE GARBAGE COLLECTION FIRST)
046 GFSSIZ: MAXFFS ;LIST
047 GFXSIZ: MAXFFX ;FIXNUM
048 GFLSIZ: MAXFFL ;FLONUM
049 DB$ GDBSIZ: MAXFFD ;DOUBLE
050 CX$ GCXSIZ: MAXFFC ;COMPLEX
051 DX$ GDXSIZ: MAXFFZ ;DUPLEX
052 BG$ GBNSIZ: MAXFFB ;BIGNUM
053 GSYSIZ: MAXFFY ;SYMBOL
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 25.1
054 002 050 HN$ GHNSIZ: REPEAT HNKLOG, MAXFFH ;HUNKS
055 GSASIZ: MAXFFA ;SARS
056 025 046 IFN .-GFSSIZ-NFF, WARN [G--SIZ TABLE WRONG LENGTH]
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 26
001
002 ;;; ROOTS OF THE CHAINS LINKING LIKE PAGES IN THE GARBAGE COLLECTOR
003 ;;; SEGMENT TABLE (GCST). FILLED IN AT INIT TIME.
004 FSSGLK: 0 ;LIST
005 FXSGLK: 0 ;FIXNUM
006 FLSGLK: 0 ;FLONUM
007 DB$ DBSGLK: 0 ;DOUBLE
008 CX$ CXSGLK: 0 ;COMPLEX
009 DX$ DXSGLK: 0 ;DUPLEX
010 BG$ BNSGLK: 0 ;BIGNUM
011 SYSGLK: 0 ;SYMBOL
012 002 050 HN$ HNSGLK: REPEAT HNKLOG, 0 ;HUNKS
013 SASGLK: 0 ;SARS
014 026 004 IFN .-FSSGLK-NFF, WARN [--SGLK TABLE WRONG LENGTH]
015 S2SGLK: 0 ;THIS MUST FOLLOW THOSE ABOVE! (SYMBOL BLOCKS)
016
017 BTSGLK: 0 ;LINKED LIST OF BIT BLOCKS
018 IMSGLK: 0 ;LINKED LIST OF UNALLOCATED IMPURE SEGMENTS (INIT SETS UP)
019 PRSGLK: 0 ;LINKED LIST OF UNALLOCATED PURE SEGMENTS
020 10$ SVPRLK: 0 ;SAVED PRSGLK WHEN HISEG GETS PURIFIED
021 002 065 IFN LHFLAG, LHSGLK: 0 ;LINKED LIST OF BLOCKS FOR LH HACK
022
023
024 BTBAOB:
025 005 042 10% -<NBITSG*SEGSIZ/BTBSIZ>+NBITB,,BFBTBS←<5-SEGLOG>
026 230 028 10$ -<NBITSG*SEGSIZ/BTBSIZ>+NBITB,, .SEE IN10S5
027 230 043 MAINBITBLT: BFBTBS-1 ;END ADDRESS FOR BLT OF MAIN BIT BLOCK AREA
028 GC98: 0 ;RANDOM TEMP FOR GC
029 GC99: 0 ;RANDOMER TEMP FOR GC
030
031
032 .SEE SPURSIZE ;SIZE OF PURE FREE STORAGE AREAS - USED MAINLY BY STATUS,
033 .SEE LDXQQ2 ; BUT ALSO RANDOMLY USED BY DEC-10 FASLOAD INTO HISEG
034 008 004 PFSSIZ: NPFSSG*SEGSIZ ;LIST
035 008 004 PFXSIZ: NPFXSG*SEGSIZ ;FIXNUM
036 008 004 PFLSIZ: NPFLSG*SEGSIZ ;FLONUM
037 DB$ PDBSIZ: 0 ;AIN'T NO INITIAL PURE DOUBLES, SONNY!
038 CX$ PCXSIZ: 0 ;AIN'T NO INITIAL PURE COMPLICES, MAMA!
039 DX$ PDXSIZ: 0 ;AIN'T NO INITIAL PURE DUPLICES, DADDY!
040 BG$ PBNSIZ: 0 ;AIN'T NO INITIAL PURE BIGNUMS, BABY!
041 0 ;AIN'T NEVER NO PURE SYMBOLS!
042 002 050 HN$ PHNSIZ: REPEAT HNKLOG, 0 ;HUNKS (YOU GOTTA BE KIDDING!)
043 0 ;AIN'T NEVER NO PURE SARS NEITHER!
044 026 034 IFN .-PFSSIZ-NFF, WARN [P--SIZ TABLE WRONG LENGTH]
045 008 004 PS2SIZ: NSY2SG*SEGSIZ ;SYMBOL BLOCKS
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 27
001
002 ;;; ********** HAIRY PARAMETERS HACKED BY ALLOC **********
003
004 BPSH: ;BINARY PROG SPACE HIGH
005 10$ 0 ;FILLED IN BY ALLOC
006 231 022 10% <<ENDLISP+PAGSIZ-1>&PAGMSK>-1
007
008 BPSL: BBPSSG ;BINARY PROG SPACE LOW
009
010 005 006 IFN ITS+D20,[
011 HINXM: 0 ;ADDRESS OF LAST WORD OF NXM HOLE
012 ] ;END OF IFN ITS+D20
013 005 005 IFN D10,[
014 HIXM: 0 ;ADDRESS OF LAST WORD OF LOW SEGMENT
015 MAXNXM: 0 ;HIGHEST USABLE WORD OF NXM ABOVE LOW SEGMENT
016 231 030 HBPORG: ENDHI ;FIRST AVAILABLE WORD OF HISEG FOR LOADING BINARY PROGRAMS
017 231 030 HBPEND: IF1,[0] IF2,[HILOC+<<ENDHI-HILOC-STDHI+PAGSIZ-1>&PAGMSK>-1]
018 ] ;END OF IFN D10
019
020 ;;; THESE TWO VALUES ARE USED FOR A QUICK-AND-DIRTY PDL NUMBER CHECK.
021 094 012 .SEE PDLNMK
022 048 005 .SEE SPECBIND ;AND OTHERS
023 NPDLL: 0 ;LOW END OF NUMBER PDL AREA
024 NPDLH: 0 ;HIGH END OF NUMBER PDL AREA
025
026
027 002 026 IFN ITS,[
028 PDLFL1: 0 ;FOR FLUSHING PDL PAGES - SEE ERINIT
029 PDLFL2: 0 ;FOR UPDATING ST - SEE ERINIT
030 ] ;END OF IFN ITS
031
032 ;;; THE NEXT FEW THINGS MUST BE IN THIS ORDER
033
034 .SEE SSGCMAX ;MAXIMUM SIZES FOR STORAGE SPACES
035 XFFS: 0 ;LIST
036 XFFX: 0 ;FIXNUM
037 XFFL: 0 ;FLONUM
038 DB$ XFFD: 0 ;DOUBLE
039 CX$ XFFC: 0 ;COMPLEX
040 DX$ XFFZ: 0 ;DUPLEX
041 BG$ XFFB: 0 ;BIGNUM
042 XFFY: 0 ;SYMBOL
043 002 050 HN$ XFFH: REPEAT HNKLOG, MAXFFH ;HUNKS
044 XFFA: 0 ;SARS
045 027 035 IFN .-XFFS-NFF, WARN [XFF- TABLE WRONG LENGTH]
046
047 005 006 IFN ITS+D20,[
048 ;;; THE NEXT FOUR THINGS MUST BE IN THIS ORDER
049 XPDL: MAXPDL ;MASTER PDL POSITIONS TO GIVE
050 XFLP: MAXFLP ; PDL-LOSSAGE INTERRUPTS AT
051 XFXP: MAXFXP
052 XSPDL: MAXSPDL
053 ;;; THE NEXT FOUR THINGS MUST BE IN THIS ORDER
FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS LISP.393[MAC,LSP] 01/17/78 Page 27.1
054 ZPDL: MAXPDL ;ACTUAL PDL POSITIONS FOR LOSING
055 ZFLP: MAXFLP ;INITIALIZED AT ERINIT FROM XPDL ET AL.
056 ZFXP: MAXFXP ; AND DIDDLED BY PDLOV AT OVERFLOW TIME
057 ZSPDL: MAXSPDL
058 ] ;END OF IFN ITS+D20
059
060 ;;; THE NEXT FOUR THINGS MUST BE IN THIS ORDER
061 230 080 C2: -PAGSIZ+NACS+1+2,,PDLORG-1 ;STANDARD REG PDL PTR
062 230 081 FLC2: -PAGSIZ+2,,FLPORG-1 ;STANDARD FLO PDL PTR
063 230 082 FXC2: -PAGSIZ+2,,FXPORG-1 ;STANDARD FIX PDL PTR
064 230 079 SC2: -PAGSIZ+1+2,,SPDLORG ;STANDARD SPEC PDL PTR
065 ;SC2 IS INITIALIZED TO ONE SLOT HIGHER THAN MIGHT BE EXPECTED
066 ; IN ORDER TO ACCOMMODATE A ONE-SLOT OVERPOP IN SOME PLACES.
067 049 002 .SEE ERRPOP
068 230 079 ZSC2: SPDLORG ;SC2 WITH ZERO LEFT HALF
069
070 ;;; THE NEXT FOUR THINGS MUST BE IN THIS ORDER
071 OC2: 0 ;ABS LIMITS FOR PDLS
072 OFLC2: 0
073 OFXC2: 0
074 OSC2: 0
RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 28
001
002 SUBTTL RANDOM VARIABLES IN LOW CORE
003
004 ;;; I GUESS THIS STUFF NEED NOT BE CONSIDERED SACRED
005
006
007 023 024 Q% MAYBE LINTAR==NFF+3
008 023 024 Q$ MAYBE LINTAR==20+10*JOBQIO+5*USELESS+NFF ;ENOUGH FOR ALL CHANNELS AND INFERIORS AND USELE
;SS INTERRUPTS AND GC OVERFLOWS
009
010 INTAR: 0 ;INDEX INTO INTERRUPT ARRAY (FIFO QUEUE)
011 028 007 BLOCK LINTAR ;ENTRIES OF FORM <INT #,,ARG FOR INT FN>
012 ;RIGHT HALVES ARE PROTECTED BY GC
013
014
015 023 024 Q% MAYBE LUNREAR==NFF+3
016 023 024 Q$ MAYBE LUNREAR==20+10*JOBQIO+5*USELESS+NFF ;ENOUGH FOR ALL CHANNELS AND INFERIORS AND USELESS INTER
;RUPTS AND GC OVERFLOWS
017
018 UNRC.G: 0 ;-2/-3 FOR DELAYED ↑X/↑G INTERRUPT
019 002 051 Q$ IFN USELESS, UNRCLI: 0 ;ENTRY FOR DELAYED CLI INTERRUPT
020 002 051 Q$ IFN USELESS, UNRMAR: 0 ;ENTRY FOR DELAYED MAR INTERRUPT
021 UNRRUN: 0 ;ENTRY FOR DELAYED RUNTIME ALARMCLOCK
022 UNRTIM: 0 ;ENTRY FOR DELAYED REAL TIME ALARMCLOCK
023 UNREAR: 0 ;INDEX INTO "REAL TIME" INTERRUPT QUEUE
024 028 015 BLOCK LUNREAR ;ENTRIES OF FORM <ARG FOR INT FN,,INT #>
025 ;ARGS IN UNREAR NEED NO GC PROTECTION
026 069 004 .SEE NOINTERRUPT
027
028 002 048 IFN QIO,[
029 ;;; INTERRUPT PDL
030
031 002 026 IFN ITS,[
032 LIPSAV==:10 ;LENGTH OF CRUD PUSHED BY INTERRUPT
033 IPSWD1==:-7 ;WORD ONE (.PIRQC) INTERRUPTS TAKEN
034 IPSWD2==:-6 ;WORD TWO (.IFPIR) INTERRUPTS TAKEN
035 IPSDF1==:-5 ;SAVED .DF1
036 IPSDF2==:-4 ;SAVED .DF2
037 IPSPC==:-3 ;SAVED PC
038 IPSD==:-2 ;SAVED ACCUMULATOR D
039 IPSR==:-1 ;SAVED ACCUMULATOR R
040 IPSF==:0 ;SAVED ACCUMULATOR F
041 ] ;END OF IFN ITS
042
043 MXIPDL==4 ;MAX SIMULTANEOUS INTERRUPTS
044 ; (CALCULATED FROM THE DEFER WORDS
045 ; IN THE INTERRUPT VECTOR):
046 ; 1 MISCELLANEOUS
047 ; 2 PDL OVERFLOW
048 ; 1 MEMORY ERROR/ILLEGAL OP
049 028 043 LINTPDL==LIPSAV*MXIPDL+1 .SEE PDLOV
050 181 046 INTPDL: -LINTPDL,,INTPDL .SEE INTVEC
051 028 032 BLOCK LINTPDL+2*LIPSAV .SEE PDLOV ;EXTRA ROOM FOR ONE INTPDL OVERFLOW AND RESULTING EXTRA
RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 28.1
;INTERRUPT
052
053 ] ;END OF IFN QIO
RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 29
001
002 ;;; LH OF MUNGP => GC IS IN PROCESS OF USING MARK BITS
003 ;;; IN SARS OR SYMBOLS
004 ;;; RH OF MUNGP => ALIST IS IN PROCESS OF USING LH'S OF
005 ;;; VALUE CELLS FOR SPECPDL HACKERY
006 ;;; ERINIT CHECKS MUNGP AND ATTEMPTS TO RESTORE THINGS IF
007 ;;; NECESSARY. THIS SHOULD HAPPEN ONLY IN THE CASE OF SOME
008 ;;; GROSS BUG LIKE A MEMORY VIOLATION.
009 MUNGP: 0
010
011
012 ;;; TEMPORARIES FOR FASLOAD
013
014 BFTMPS::
015 SQ6BIT: 0 ;TEMPORARIES FOR SQUEEZE
016 SQSQOZ: 0
017 LDBYTS: 0 ;WORD OF RELOCATION BYTES
018 LDOFST: 0(TT) ;LOAD OFFSET (RELOCATION FACTOR = VALUE OF BPORG BEFORE LOAD)
019 LDAAOB: 0 ;AOBJN INDEX FOR ATOMTABLE ARRAY
020 LDTEMP: ;RANDOM TEMPORARY
021 LD6BIT: 0 ;PLACE TO ACCUMULATE SIXBIT WHILE CONVERTING FROM SQUOZE
022 ; - FIRST 6 BITS OF NEXT WORD MUST BE ZERO
023 LDAPTR: 0(TT) ;WILL BE AN INDIRECT POINTER FOR ACCESSING THE ATOMTABLE
024 LDBPTR: 0(F) ;WILL BE AN INDIRECT POINTER FOR ACCESSING THE I/O BUFFER
025 LDF2DP: 0 ;.FNAM2-DIFFERENT-P (NON-ZERO MEANS FASLAP'S LDFNM2 WAS DIFFERENT FROM CURRENT FASLOAD'S
;)
026 LDASAR: 0 ;ADDRESS OF SAR FOR FASLOAD'S ATOMTABLE ARRAY
027 LDBSAR: 0 ;ADDRESS OF SAR FOR FASLOAD'S I/O BUFFER ARRAY
028 LDXBLT: 0 ;BLT POINTER FOR ZAPPING CALLS FOR XCTS IN BPS
029 LDXSIZ: 0 ;0=XCT HACKERY NEVER DONE, -1=DONE AND PURIFIED, N>0=LENGTH (IN WORDS) OF AREA FOR XCTED
; CALLS
030 LDXSM1: 0 ;CONTAINS 1 LESS THAN LDXSIZ, AND RETAINS VALUE AFTER LDXSIZ BECOMES -1
031 181 046 LDXDIF: 0(D) .SEE LDPRC6 ;RH WILL CONTAIN DIFFERENCE BETWEEN RH AND LH OF LDXBLT
032 LDHLOC: 0 ;HIGHEST LOC ASSEMBLED INTO + 1
033 LDEOFJ: 0 ;JUMP ADDRESS FOR END OF FASLOAD INPUT FILE
034 10$ LDEOFP: 0 ;USED FOR EOF HANDLING IN FASLOAD FOR D10
035 029 014 LFTMPS==:.-BFTMPS ;NUMBER OF FASLOAD TEMPORARIES
RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 30
001
002 IT$ IUSN: 0 ;INITIAL USER SNAME - SET BY LISPGO
003 002 048 IFE QIO,[
004 USN: BLOCK 2 ;USER SYSTEM NAME
005
006 IT$ UTOBYT: -1 ;# OF VACANT BYTES LEFT IN UTAPE OUTPUT BUFFER
007 UTOOPD: 0 ;UTAPE OUTPUT OPENED FLAG (NON-ZERO MEANS TRUE)
008 UTIOPD: 0 ;UTAPE INPUT OPENED FLAG
009 UTIN: (SIXBIT \DSK\) ;FOR ITS, HAS MODE BITS IN LH, 3 SIXBIT CHARS FOR DEVICE IN RH
010 BLOCK 4 ;FOR ITS, USED AS DATA BLOCK ON OPENS
011 UWRT: 0
012 ] ;END OF IFE QIO
013
014 005 005 IFN D10,[
015 002 048 IFE QIO,[
016 UWUSN: 0 ;UWRITE SNAME (I.E. PPN)
017 D10PTR: 0 ;AOBJN POINTER FOR DEC BUFFERS..
018 D10ARD: -200,,. ;I/O WORD FOR ARRAY DUMP AND FASL
019 0
020 D10NAM: 0 ;THIS WORD ;WILL BE ###LSP WHERE ###=JOB NR
021 D10REN: BLOCK 2 ;FILE NAME TO
022 ] ;END OF IFE QIO
023 SYMLO: 0 ;LOW BOUNDARY FOR DDT'S SYMBOL TABLE
024 UPCOK: -1 ;-1 => TYPING ↑C IS OK. NON-NEG INHIBITS,
025 ; AND CAUSES DELAY OF ↑C INTERRUPTS.
026 ; POS => THERE IS A ↑C REQUEST STACKED UP.
027 ] ;END OF IFN D10
028
029 002 048 IFE QIO,[
030 UUN: BLOCK 2 ;UNAME
031 UFN1: BLOCK 2 ;FN1, LFT BY MOST RECENT UREAD, FASLOAD
032 UFN2: BLOCK 2
033 URFN1: BLOCK 2
034 URFN2: BLOCK 2 ;FN2
035
036 SPP: 0 ;PAGE-PAUSE-P PAUSE AT END OF DATAPOINT PAGE IF NON-NIL
037 SRNLN1: 0 ;SCREEN LENGTH FOR DISPLAY TERMINAL, 0 FOR PRINTING
038 PAUSFL: 0 ;FLAG TO HANG ON PAUSE FEATURE, -1 TO CONTINUE, +N TO CLEAR SCREEN
039 STTYSS: 0 ;TTY STATUS WORD
040 STTYS1: 0 ;TTY INTERRUPT AND WAKEUP CONTROL, FIRST WORD
041 STTYS2: 0 ; SECOND WORD; MUST FOLLOW FIRST!
042 TTYDISP: -1 ;TERMINAL TYPE (0 => PRINTING)
043 LINMODE: SA% NIL ;NON-NIL => LINE BUFFERING MODE (STATUS LINMODE)
044 SA$ TRUTH
045 ] ;END OF IFE QIO
046
047
048 RDOBJ8: RD8N ;OR RD8W FOR WHITE'S + HAC
049 ALGCF: 0 ;FLAG TO STOP THE GC WHILE IN ALLOC
050 AFILRD: -1 ;-1 => NO INIT FILE, >0 => CDR OF ALLOC COMMENT
051
052 GNUM: ASCII \G0000\ ;INITIAL GENSYM
053
RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 30.1
054
055 ;;; RANDOM STUFF FOR RANDOM NUMBER GENERATOR
056 ;;; RNOWS, RBACK, AND RBLOCK MUST BE IN THAT ORDER.
057
058 002 051 IFN USELESS,[
059 MAYBE LRBLOCK==:71. ; 71 35
060 MAYBE ROFSET==:35. ;X +X +1 IS IRREDUCIBLE MOD 2 (ASK MACSYMA!)
061 ] ;END OF IFN USELESS
062 002 051 IFE USELESS,[
063 MAYBE LRBLOCK==:7 ; 7 3
064 MAYBE ROFSET==:3 ;SO ALSO IS X +X +1 IRREDUCIBLE MOD 2
065 ] ;END OF IFE USELESS
066
067 RNOWS: 0 .SEE INIRND ;INITIALIZED AT INIT TIME
068 RBACK: 0 .SEE SSRANDOM ;CAN BE RESTORED BY (SSTATUS RANDOM ...)
069 030 059 RBLOCK: BLOCK LRBLOCK .SEE RANDOM ;BLOCK OF RANDOM CRUD
070
071 002 048 IFE QIO,[
072 002 029 IFN SAIL,[
073 ACLKTYP: 0 ;Q$RUNTIME OR QTIME
074 AINT: 0 ;SAVE A DURING ALARM
075 ATTSV: 0 ;SAVE TT DURING ALARM
076 SAINTER: 200,,0 ;NEW STYLE CLOCK INTERRUPT MASK
077 SAICONT:0 ;CONTINUE POINT FOR INTUUO
078 SAIALK: 0
079 SAILJOB: 0
080 AIPCLOK: 0
081 0
082 ] ;END OF IFN SAIL
083 ] ;END OF IFE QIO
RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 31
001
002 002 042 IFN EDFLAG,[
003
004 EDPRFL: 0
005 EDPRN: EDPRW
006 EDEX2: 0
007
008 ] ;END OF IFN EDFLAG
009
010
011
012 002 039 IFN MOBIOF,[
013
014 NVSCL: 20,, ;SCALING FOR NVFIX - NORMALLY CONVERTS 0 - 37777 TO 0 1777
015 FTVO: SIXBIT \ &DSK\ ;FAKE TV STUFF
016
017 BLOCK 2
018 CURBLK: 0 ;NUMBER OF BLOCK STORED IN ARRAY POINTED TO BY BUFFER
019 BUFFER: 0 ;POINTER TO SAR OF BUFFER ARRAY
020 NFTVBL: 0 ;CURRENT NUMBER OF BLOCKS IN CORE
021 MFTVBL: 4 ;MAX ALLOWABLE, BEFORE DELETIONS OF BLOCKS IN CORE OCCURS
022 XBLOKS: 0
023 YBLOKS: 0
024 NBLOKS: 0 ;TOTAL NUMBER OF BLOCKS
025 XLL: 0 ;X LOWER-LEFT
026 YLL: 0 ;Y "
027 XUR: 0 ;X UPPER-RIGHT
028 YUR: 0 ;Y "
029
030 NVDCL: 0 ;DIM CUTOFF LEVL
031 NVCFL: 0 ;CONFIDENCE LEVEL OF IMAGE
032 NVDK: 0 ;DIM CUTOFF ON FAKETV
033 ODCL: 0 ;LAST DIM CUTOFF ON FAKETV
034
035 PLTTBP: 0 ;BYTE POINTER FOR PLOTTEXT
036 PLTTBF: 0 ;BUFFER FOR PLOTTEXT
037 PLTLST: 0 ;CELL FROM WHICH TO DO A PSTRTL
038
039 ] ;END OF IFN MOBIOF
RANDOM VARIABLES IN LOW CORE LISP.393[MAC,LSP] 01/17/78 Page 32
001
002 002 048 IFE QIO,[
003 002 026 IFN ITS, URCHST: BLOCK 6 ;FOR UREAD'S .RCHST (READ CHANNEL STATUS)
004 POV2: . ;ADDRESSES OF ERROR MESAGE FOR PDLOV
005 LTYOC: 0 ;NON-ZERO => LAST CHAR OUTPUT BY TYO WAS A SLASH
006 PBFTY: 0 ;CHARACTER BUFFERED UP IN TTY CHANNEL
007 002 026 IFN ITS, IODF1: SIXBIT \↑M !\ ;TO BE USED WHEN A DEVICE FULL MESSAGE NEEDED
008 ] ;END OF IFE QIO
009
010 RNTN2: .(T) ;CURRENT PNBUF WORD FOR COMPARE ON INTERN
011
012 ;;; VARIABLES FOR ARRAY ALLOCATOR
013 BPPNR: 0 ;<SIZE OF ARRAY HEADER>,,-<SIZE OF ARRAY DATA>
014 GAMNT: 0 ;NUMBER OF WORDS REQUIRED, ON A CALL TO GETSP
015 GSBPN: 0 ;USED AS TEMPORARY BPEND WHILE BLT'ING DOWN ARRAYS
016 ADDSAR: 0 ;ADDRESS OF SPECIAL ARRAY CELL WHEN MAKIN ARRAY
017 TOTSPC: 0 ;<# OF ARRAY DIMS>,,<TOTAL SPACE NEEDED FOR ARRAY>
018 LLIP1: 0 ;<LARGEST LEGAL INDEX OF ARRAY>+1
019 INSP: 0 ;PSEUDO-PDL POINTER FOR ARRAY-ING
020
021
022 RTSP1: 0
023 RTSP3: 0
024 LOSEF: 77 ;LAP OBJECT STORAGE - EFFICIENCY FACTOR. FOR (STATUS LOSEF) = N,
025 ;THERE WILL BE <1←N>-1 STORED HERE. SIZE OF GC PROTECTION ARRAY
026 RWG: 0 ;IF = 0, THEN CREATE ERROR ON DIVIDE BY ZERO,
027 ;OR FLOATING OVFLO ON CONVERSION OF BIGNUM
028 FLOV9A: 0 ;RANDOM TEMPS FOR FLOATING POINT
029 FLOV9B: 0 ; OVERFLOW INTERRUPT HANDLER
030 CPJSW: 0 ;IF NOT ZERO, THEN *RSET WAS ON, AND BAKTRACE WILL FIND MUCH
031 ;INFORMATION FROM THE [FUN,,CPOPJ] TYPE STUFF ON THE PDL
032 PSYMF: 0 ;NON-ZERO DURING EXECUTION OF PSYM.
033 POFF: 0 ;VARIOUS ROUTINES INVOLVING $X'S FROM DDT DO JSR'S HERE
034 142 020 JRST PSYM1
035 PSMS: BLOCK 20 ;THIS SHOULD BE ENOUGH FOR LPSMTB
036 BLOCK 3
037 PSMTS: 0
038 PSMRS: 0
039 IT$ SQUOZE 0,. ;FOR A .BREAK 12,[4,,PS.S-1]
040 142 020 PS.S: 0 .SEE PSYM1
041 002 026 IFN <1-QIO>*ITS,[
042 RD0S3: ASCII \⊂H↑H⊂V\ ;REPOSITION DISPLAY CURSOR
043 0 ; (↑P H ↑H ↑P V)
044 ] ;END OF IFE QIO
045
046 STQLUZ: 0 ;FOR LOSSAGE OF SETQING NIL OR T - REMEMBER WHICH ONE OVER INTWAIT
047
048 Q% OLINEL: 0 ;INITIAL SETTING OF LINEL BY TTYOPN (THIS IS AN
049 ; NLISP INUM; HENCE NEEDS NO GC PROTECTION)
050
051 NOPFLS: 0 ;NON-ZERO => PURIFY$G SHOULDN'T FLUSH PDLS
052
053 SAWSP: -1 ;SCREW-AROUND-WITH-SHARING-P
KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33
001
002
003 SUBTTL KILHGH AND GETHGH
004
005 005 005 IFN D10,[
006
007 033 037 KILHGH: MOVEI A,GETHGH ;KILL HIGH SEGMENT
008 HRRM A,.JBSA" ;SET START ADDRESS
009 002 029 IFE SAIL,[
010 033 161 SKIPE SGANAM ;CAN'T FLUSH HIGH SEGMENT IF WE
011 033 164 SKIPN SGADEV ; DON'T KNOW WHEREFROM TO RETRIEVE IT
012 209 011 JRST .+3
013 MOVSI A,1
014 CORE A, ;FLUSH HIGH SEGMENT
015 JFCL
016 KILHG1:
017 ] ;END OF IFE SAIL
018 002 029 IFN SAIL,[
019 033 161 SKIPN SGANAM
020 033 016 JRST KILHG1
021 033 170 MOVEI A,FAKDDT ;FOO, HOW MANY WAYS CAN SAIL LOSE?
022 SKIPN .JBDDT ; JOBDDT MUST BE NON-ZERO TO SAVE!
023 SETDDT A, ; OTHERWISE MAY FAIL TO SAVE ENTIRE LOSEG
024 131 052 SETZ A,
025 CORE2 A, ;FLUSH HIGH SEGMENT
026 006 115 HALT ;HOW CAN WE POSSIBLY LOSE? (HA HA)
027 033 034 JRST KILHG2
028
029 KILHG1: SKIPL .JBHRL
030 033 034 JRST KILHG2
031 MOVEI A,1
032 SETUWP A,
033 006 115 HALT
034 KILHG2:
035 ] ;END OF IFN SAIL
036 EXIT 1, ;"CONTINUE" WILL FALL INTO GETHGH
037 GETHGH:
038 002 029 IFE SAIL,[
039 MOVEI A,A+1 ;SET UP TO GET HIGH SEG BACK
040 033 164 MOVE A+1,SGADEV
041 033 161 MOVE A+2,SGANAM
042 SETZB A+3,A+4
043 033 167 MOVE A+5,SGAPPN
044 033 161 SKIPE SGANAM
045 033 164 SKIPN SGADEV
046 033 049 JRST GETHG1
047 GETSEG A, ;GET HIGH SEGMENT
048 033 105 JRST GLSLUZ
049 GETHG1:
050 ] ;END OF IFE SAIL
051 002 029 IFN SAIL,[
052 RESET
053 SKIPE .JBHRL
KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33.1
054 033 049 JRST GETHG1
055 033 161 MOVE T,SGANAM
056 ATTSEG T,
057 033 164 SKIPA TT,SGADEV
058 033 115 JSP FREEAC,CHKHGH
059 MOVEI T,.IODMP ;ON FAILURE, WE LOCK THE .SHR FILE, THEN TRY AGAIN,
060 131 052 SETZ D, ; AND ON FAILING MAKE THE HISEG OURSELVES
061 017 021 OPEN TMPC,T ;OPEN UP .SHR FILE DEVICE IN DUMP MODE
062 006 115 HALT ;CONCEIVABLY SOME MORON GAVE LOSING SECOND ARG TO SUSPEND?
063 033 161 MOVE T,SGANAM
064 033 168 MOVE TT,SGAEXT
065 131 052 SETZ D,
066 033 167 MOVE R,SGAPPN
067 017 021 LOOKUP TMPC,T
068 033 105 JRST GLSLUZ ;LOOK UP .SHR FILE
069 071 024 MOVS F,R
070 TRZ TT,-1 ;WE NOW OPEN IT FOR READ-ALTER MODE FOR
071 017 021 GETSTS TMPC,D ; FAST READ-ALTER
072 181 046 TDO D,1000 ; FAST READ-ALTER BIT
073 181 046 HRRM D,.+1
074 017 021 SETSTS TMPC,
075 131 052 SETZ D, ; THE SOLE PURPOSE OF PREVENTING OTHER
076 033 167 MOVE R,SGAPPN ; JOBS FROM READING IT TOO, THEREBY
077 017 021 ENTER TMPC,T ; CAUSING WEIRD RACE CONDITIONS
078 033 105 JRST GLSLUZ
079 033 161 MOVE T,SGANAM
080 ATTSEG T, ;SEE IF SOMEONE ELSE HAS SAME HISEG; THIS CAN
081 SKIPA T,F ; HAPPEN IF SOME OTHER JOB GETS THROUGH THIS
082 033 115 JSP FREEAC,CHKHGH ; CODE BETWEEN OUR FIRST ATTSEG AND THE ENTER
083 MOVNS T ;T GETS LENGTH OF .SHR FILE
084 ADD T,.JBREL
085 071 024 HRR R,.JBREL ;MUST GOBBLE SOME COPIES OF .JBREL
086 HRRZ TT,.JBREL ; BEFORE THE CORE UUO CHANGES IT
087 CORE T, ;EXTEND LOSEG BY THIS AMOUNT
088 033 146 JRST GLSLZ1
089 131 052 SETZ F,
090 017 021 IN TMPC,R ;READ IN HISEG
091 033 161 SKIPA T,SGANAM
092 033 213 JRST LDSCRU
093 TLO TT,400000 ;WRITE PROTECT HISEG
094 REMAP TT, ;LET'S SPLIT
095 033 154 JRST GLSLZ3
096 GETHG1:
097 033 161 MOVE T,SGANAM
098 SETNM2 T,
099 006 115 HALT
100 017 021 RELEASE TMPC, ;FLUSH TEMP CHANNEL *AFTER* CREATING THE HISEG
101 ] ;END OF IFN SAIL
102 222 008 JSP F,JCLSET ;GOBBLE DOWN ANY JCL
103 209 011 RETHGH: JRST . ;RETURN ADDR CLOBBERED IN HERE
104
105 GLSLUZ:
106 002 029 IFN SAIL,[
KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33.2
107 017 021 RELEASE TMPC,
108 TLZ TT,-1
109 CAIE TT,ERFBM% ;COLLISION DUE TO LOCKOUT?
110 033 137 JRST GLSLZ0 ;NO, GENUWINE LOSSAGE
111 PJOB TT, ;THIS IS ALL PRETTY RANDOM - WE'RE
112 IDIVI TT,7 ; TRYING JUST A LITTLE BIT TO SOLVE
113 181 046 SLEEP D, ; THE HAIRY RACE CONDITIONS (ALOHA!)
114 033 037 JRST GETHGH
115 CHKHGH:
116 033 167 MOVE D,SGAPPN
117 039 009 CAME D,PSGPPN
118 033 130 JRST GLSLZ4
119 033 164 MOVE D,SGADEV
120 039 007 CAME D,PSGDEV
121 033 130 JRST GLSLZ4
122 033 168 MOVE D,SGAEXT
123 039 008 CAME D,PSGEXT
124 033 130 JRST GLSLZ4
125 033 161 MOVE D,SGANAM ;CHECK HISEG VALIDATION WORDS
126 039 006 CAME D,PSGNAM
127 033 130 JRST GLSLZ4
128 033 049 JRST GETHG1
129
130 131 052 GLSLZ4: SETZ T, ;WRONG HISEG, SO ZERO IT OUT AND START AGAIN
131 CORE2 T,
132 033 146 JRST GLSLZ1
133 033 164 MOVE TT,SGADEV
134 MOVE T,F
135 209 011 JRST (FREEAC)
136
137 GLSLZ0:
138 ] ;END OF IFN SAIL
139 OUTSTR [ASCIZ \?.SHR FILE WENT AWAY
140 \]
141 022 059 Q$ WARN [FOR NEWIO, CAN USE THE TABLE OF ERROR MSGS IN ERRIOJ ROUTINE]
142 EXIT ;FOO
143
144 002 029 IFN SAIL,[
145
146 GLSLZ1: OUTSTR [ASCIZ \?CORE UUO LOST
147 \]
148 EXIT
149
150 GLSLZ2: OUTSTR [ASCIZ \?IN UUO LOST
151 \]
152 EXIT
153
154 GLSLZ3: OUTSTR [ASCIZ \?REMAP LOST
155 \]
156 EXIT
157
158 ] ;END OF IFN SAIL
159
KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33.3
160
161 SGANAM:
162 SA% 0 ;THESE ARE THE SAVED NAMES FOR GETTING
163 SA$ SIXBIT \MACLSP\
164 SGADEV:
165 SA% 0 ; THE HIGH SEGMENT BACK AFTER SUSPENSION
166 SA$ SIXBIT \SYS\
167 115 002 SGAPPN: 0 .SEE SUSPEND
168 SGAEXT: SIXBIT \SHR\ ;SOME LOSER MIGHT WANT TO CHANGE THIS
169
170 006 115 SA$ FAKDDT: HALT ;FOR FAKING OUT THE WORLD
171
172 MAYBE LSJCLBUF==10 ;ENOUGH FOR 40. CHARS
173 SJCLBUF: 0 ;FIRST WORD HOLD NUMBER OF CHARS BUFFERED
174 033 172 BLOCK LSJCLBUF
175 0 ;INSURES THAT ILDBS WILL FINALLY SEE A ZERO
176
177 ;;; CODE FOR FASLOAD TO READ IN A NEW HIGH SEGMENT.
178 ;;; THIS CODE MUST BE IN THE LOW SEGMENT!
179 ;;; T HAS LENGTH OF THE .SHR FILE; LH(R) HAS NEGATIVE OF THIS.
180
181 LDRIHS:
182 002 029 IFE SAIL,[
183 MOVSI TT,1
184 CORE TT, ;FLUSH OLD HIGH SEGMENT
185 033 213 JRST LDSCRU
186 HRRZ TT,.JBREL ;CURRENT HIGHEST ADDRESS IN LOSEG
187 181 046 HRRZ D,.JBREL
188 071 024 HRR R,.JBREL
189 ADD TT,T
190 CORE TT, ;EXPAND LOSEG SO CAN HOLD COPY OF HISEG
191 033 213 JRST LDSCRU ; (REMEMBER, CAN'T DO I/O INTO HISEG!)
192 131 052 SETZ F,
193 017 021 IN TMPC,R ;READ IN .SHR FILE
194 CAIA
195 033 213 JRST LDSCRU
196 181 046 REMAP D, ;NOW MAKE A HISEG FROM THE READ-IN CODE
197 033 213 JRST LDSCRU
198 SETUWP F, ;TOPS-10 COURTEOUSLY PROTECTS US FROM OURSELVES,
199 033 213 JRST LDSCRU ; SO WE MUST MAKE HISEG WRITABLE (F IS ZERO)
200 POPJ P,
201 ] ;END OF IFE SAIL
202 002 029 IFN SAIL,[
203 131 052 SETZ TT,
204 CORE2 TT, ;FLUSH OLD HIGH SEGMENT
205 033 213 JRST LDSCRU
206 CORE2 T, ;MAKE A NEW (WRITABLE) HISEG THAT BIG
207 033 213 JRST LDSCRU
208 071 024 HRRI R,400000-1
209 131 052 SETZ F,
210 017 021 IN TMPC,R ;READ IN HISEG
211 POPJ P, ;RETURN TO CODE IN HISEG
212 ] ;END OF IFN SAIL
KILHGH AND GETHGH LISP.393[MAC,LSP] 01/17/78 Page 33.4
213 LDSCRU: OUTSTR [ASCIZ \DEPURIFYING HISEG LOST - YOU ARE STRANDED!
214 \]
215 EXIT
216
217 ] ;END OF IFN D10
INITIAL READTABLE, OBARRAY (IN LOW CORE), AND PURTBL LISP.393[MAC,LSP] 01/17/78 Page 34
001
002 SUBTTL INITIAL READTABLE, OBARRAY (IN LOW CORE), AND PURTBL
003
004 ;;; INITIAL READ SYNTAX TABLE IN FORM OF AN ARRAY
005
006 -1,,0 ;IN NEWIO, WILL POINT TO MACRO CHAR LIST
007 064 007 RSXTB1: PUSH P,CFIX1
008 JSP TT,1DIMF
009 READTABLE
010 0
011 007 017 RCT: BLOCK LRCT-2 ;WHICH IS BLT'D IN FROM RCT0
012 TRUTH,,0 ;(STATUS TTYREAD),,(STATUS ABBREVIATE)
013 NIL,,TRUTH ;(STATUS TERPRI),,(STATUS ←)
014
015
016
017 ;;; INITIAL OBLIST IN FORM OF ARRAY
018 034 022 -<OBTSIZ+1>/2,,IOBAR2
019 IOBAR1: JSP TT,1DIMS
020 OBARRAY
021 002 044 OBTSIZ+1+200
022 002 044 IOBAR2: BLOCK <OBTSIZ+1>/2
023 BLOCK 200/2 ;SINGLE CHAR OBJS TABLE (CREATED AS NEEDED)
024
025
026
027 ;;; PURE PAGE TABLE
028 ;;; CONTAINS TWO BITS FOR EACH PAGE, 16 PAGES PER TABLE WORD
029 ;;; MEANING OF BITS: 00=NXM 01=IMPURE
030 ;;; 10=PURE 11=SPECIAL HACKERY NEEDED
031
032
033 002 026 IFN ITS,[
034
035 PURTBL:
036
037 007 036 IF1, BLOCK NPAGS/20
038
039 IF2,[
040 ZZW==. ;DARN WELL BETTER BE SAFE OVER THE FOLLOWING MESS!
041 .BYTE 2
042 ZZZ==0
043 $==3 ;FOR HAIRY PRINTOUT TO WORK
044 PRINTX \
045 034 035 INITIAL PURTBL MEMORY LAYOUT
046 [0=NXM, 1=IMPURE, 2=PURE, $=BPS/PDL/SCRATCH]
047 \
048
049 NLBTSG==0
050 NHBTSG==0
051 035 080 IFN LOBITSG, NLBTSG==NBITSG
052 .ELSE, NHBTSG==NBITSG
053
INITIAL READTABLE, OBARRAY (IN LOW CORE), AND PURTBL LISP.393[MAC,LSP] 01/17/78 Page 34.1
054 ;;; IN THE IRP BELOW, COMMAS AND CR'S MARK GUARANTEED PAGE BOUNDARIES
055
056 036 033 IRP SPCS,,[ZER+LBT,ST,SYS,SAR+VC,XVC,IS2+SYM+XXA,XXZ,SY2+PFX+PFS+PFL+XXP
057 027 050 IFS+IFX+IFL+BN+XXB,HBT,BPS,NXM,FXP,XFXP,FLP,XFLP,P,XP
058 034 043 SP,XSP,SCR]BITS,,[1,1,2,1,0,1,0,2,1,1,$,0,$,0,$,0,$,0,$,0,$]
059 ZZX==0
060 IRPS SPC,,[SPCS]
061 220 022 ZZX==ZZX+N!SPC!SG
062 TERMIN
063 008 009 REPEAT ZZX/SGS%PG,[
064 BITS
065 004 063 ZZZ==ZZZ+1
066 004 063 IFE ZZZ&17,[
067 0
068 0
069 ]
070 PRINTX \BITS\
071 004 063 IFE <ZZZ#10>&17, PRINTX \ \
072 004 063 IFE <ZZZ#20>&37, PRINTX \ \
073 004 063 IFE ZZZ&37,[
074 PRINTX \
075 \
076 ]
077 ] ;END OF REPEAT
078 TERMIN
079 .BYTE
080 007 036 IFN ZZZ-NPAGS,[
081 034 035 WARN \ZZZ,[=WRONG LENGTH FOR PURTBL (SHOULD BE ]\NPAGS,[)]
082 034 040 LOC ZZW
083 ] ;END OF IFN ZZZ-NPAGS
084
085 PRINTX \
086 \
087
088 ] ;END OF IF2
089
090 ] ;END OF IFN ITS
OLD I/O BUFFERS, PATCH AREAS LISP.393[MAC,LSP] 01/17/78 Page 35
001
002 SUBTTL OLD I/O BUFFERS, PATCH AREAS
003
004 002 048 IFE QIO,[
005 DEFINE OPNWRD A,B,E
006 O!A!C: IFSE E,, (B+SIXBIT \A\)
007 IFSN E,, (B+SIXBIT \E\)
008 A!OPD: 0
009 TERMIN
010
011 035 005 OPNWRD LPT,1
012 002 039 IFN MOBIOF,[
013 035 005 OPNWRD IPL,5
014 035 005 OPNWRD NVD,0
015 035 005 OPNWRD BVD,2,NVD
016 035 005 OPNWRD IMX,0
017 035 005 OPNWRD OMX,1
018 035 005 OPNWRD DIS,1
019 SIXOPD: 0 ;-1 FOR 6, +1 FOR 10 SLAVE
020 ] ;END OF IFN MOBIOF
021 ] ;END OF IFE QIO
022
023
024 CONSTANTS
025
026 ;;; NO MORE CONSTANTS PERMITTED AFTER THIS IN THE LOSEG (WRITEABLE FIRST PAGE)
027
028 002 048 IFE QIO,[
029
030 005 005 IFE D10,[
031
032 UTBSIZ==20
033 ZZ==.
034 SEGUP .
035 035 032 IFL .-ZZ-2*UTBSIZ-5,[
036 SEGUP .+1
037 035 033 UTBSIZ==<.-ZZ-6>/2
038 ] ;END OF IFL
039 035 033 LOC ZZ
040 035 041 UTIBP: 440700,,UTIB+UTBSIZ
041 035 032 UTIB: BLOCK UTBSIZ+1
042 035 043 UTOBP: 440700,,UTOB
043 035 032 UTOB: BLOCK UTBSIZ+1
044 SEGUP .
045 ] ;END OF IFE D10
046
047 005 005 IFN D10,[
048
049 002 066 UTBSIZ==NIOBFS*203-3 ;PURE RANDOMNESS
050
051 UTIHED: 0 ;BUFFER HEADER FOR DEC-10 UREAD INPUT
052 UTIBP: 0
053 UTIBYT: 0
OLD I/O BUFFERS, PATCH AREAS LISP.393[MAC,LSP] 01/17/78 Page 35.1
054
055 UTOHED: 0 ;BUFFER HEADER FOR DEC-10 UREAD OUTPUT
056 UTOBP: 0
057 UTOBYT: 0
058
059 FSLHED: BLOCK 3 ;FOR FASLOAD BUFFER, ETC.
060
061 BLOCK 3 ;ROOM FOR FOOLISH HEADER
062 035 032 UTIB: BLOCK UTBSIZ+1
063 BLOCK 3 ;ROOM FOR FOOLISH HEADER
064 035 032 UTOB: BLOCK UTBSIZ+1
065
066 002 045 PATCH: BLOCK PTCSIZ
067 SEGUP .
068 EPATCH==.-1
069 LOPATCH==1
070 ] ;END OF IFN D10
071
072 ] ;END OF IFE QIO
073
074 10% LOPATCH==0
075
076 031 019 IT$ Q% INFORM [UTAPE BUFFER AREAS=],\UTBSIZ,[ WORDS APIECE]
077
078 IF1,[
079 ZZ==.
080 LOBITSG==0 ;NON-ZERO ==> BITSGS ARE LOW
081 PAGEUP
082 TOP.PG==.
083 008 004 IFGE TOP.PG-ZZ-SEGSIZ,[ ;SEE IF THERE IS ANOTHER SEGMENT LEFT ON THIS PAGE
084 035 033 SEGUP ZZ
085 SPCTOP ZER,SYS,["ZERO" (LOW IMPURE)]
086 SPCBOT BIT
087 008 004 BTBLKS: BLOCK BTSGGS*SEGSIZ-1
088 SEGUP .
089 036 033 SPCTOP BIT,ST,[BIT BLOCK]
090 035 082 IFE TOP.PG-., LOBITSG==1
091 .ELSE,[
092 035 080 WARN [LOBITSG STUFF DIDN'T WORK]
093 EXPUNGE NZERSG NBITSG BBITSG
094 ] ;END OF .ELSE
095 ] ;END OF IFGE TOP.PG-ZZ-SEGSIZ
096 ] ;END OF IF1
097 IF2,[
098 10% PAGEUP
099 10$ SEGUP .
100 ] ;END OF IF2
101
102 035 080 IFE LOBITSG, SPCTOP ZER,SYS,["ZERO" (LOW IMPURE)]
103 011 054 10$ EXPUNGE BZERSG
104 035 082 EXPUNGE TOP.PG
105
SEGMENT TABLES LISP.393[MAC,LSP] 01/17/78 Page 36
001
002 SUBTTL SEGMENT TABLES
003
004 ;;; FORMAT OF SEGMENT TABLE (<NSEGS> WORDS, ONE FOR EACH SEGMENT)
005 ;;; 4.9 LS 1=LIST STRUCTURE, 0=ATOMIC
006 ;;; 4.8 $FS FREE STORAGE (BIT 4.9 SHOULD BE ON ALSO)
007 ;;; 4.7 FX FIXNUM STORAGE
008 ;;; 4.6 FL FLONUM STORAGE
009 ;;; 4.5 BN BIGNUM HEADER STORAGE
010 ;;; 4.4 SY SYMBOL HEADER STORAGE
011 ;;; 4.3 SA SAR STORAGE (BIT 3.8 SHOULD BE ON ALSO)
012 ;;; 4.2 VC VALUE CELL STORAGE (BIT 4.9 SHOULD BE ON ALSO)
013 ;;; 4.1 $PDLNM NUMBER PDL AREA (ONE OF THE NUMBER TYPE BITS SHOULD BE ON ALSO)
014 ;;; 3.9 RESERVED - AVOID USING (FORMERLY $FLP)
015 ;;; 3.8 $XM EXISTENT (RANDOM) AREA
016 ;;; 3.7 $NXM NONEXISTENT (RANDOM) AREA
017 ;;; 3.6 PUR PURE SPACE (ONE OF BITS 4.8-4.5 OR 3.8 SHOULD BE ON)
018 ;;; 3.5 HNK HUNK OF ONE KIND OR ANOTHER (BIT 4.9 ON ALSO)
019 ;;; 3.4 DB DOUBLE-PRECISION FLONUMS ;THESE ARE
020 ;;; 3.3 CX COMPLEX NUMBERS ; NOT YET
021 ;;; 3.2 DX DOUBLE-PRECISION COMPLEX NUMBERS ; IMPLEMENTED
022 ;;; 3.1 UNUSED
023 ;;; 2.9-1.1 ADDRESS OF A DATA TYPE, ATOM:
024 ;;; QLIST, QFIXNUM, QFLONUM, QBIGNUM,
025 ;;; QSYMBOL, QRANDOM, QARRAY, QHUNK<N>
026 ;;; NOTE THAT THESE ATOMS OCCUPY CONSECUTIVE MEMORY
027 ;;; LOCATIONS AND THUS NUMERICALLY ENCODE THE PAGE TYPE.
028 .SEE LS ;;; THIS COMMENT SHOULD BE KEPT CONSISTENT WITH THE DEFINITIONS (IN THE
029 145 075 .SEE PSYMTT ;;; DEFNS FILE) FOR THE ABOVE SYMBOLS, AND WITH LOCATION PSYMTT.
030
031 036 033 SPCBOT ST
032
033 ST: ;SEGMENT TABLE
034 008 007 IFE ITS, BLOCK NSEGS ;FOR DEC-10, CODE IN INIT SETS UP THESE TABLES AT RUN TIME.
035 002 026 IFN ITS,[
036 008 007 IF1, BLOCK NSEGS
037 IF2,[
038 036 038 STDISP: EXPUNGE STDISP ;FOR .SEE
039 $ST ZER,$XM ;"ZERO" (LOW IMPURE) SEGMENTS
040 035 080 IFN LOBITSG, $ST BIT,$XM ;BIT BLOCKS
041 036 033 $ST ST,$XM ;SEGMENT TABLES
042 $ST SYS,$XM+PUR ;SYSTEM CODE
043 $ST SAR,SA ;SARS (ARRAY POINTERS)
044 $ST VC,LS+VC ;VALUE CELLS
045 $ST XVC,$NXM ;RESERVED FOR EXTRA VALUE CELLS
046 $ST IS2,$XM ;IMPURE SYMBOL BLOCKS
047 004 029 $ST SYM,SY ;SYMBOL HEADERS
048 $ST XXA,$XM ;SLACK SEGMENTS (IMPURE!)
049 $ST XXZ,$NXM ;SLACK SEGMENTS (INITIALLY NXM)
050 $ST SY2,$XM+PUR ;PURE SYMBOL BLOCKS
051 $ST PFX,FX+PUR ;PURE FIXNUMS
052 $ST PFS,LS+$FS+PUR ;PURE FREE STORAGE (LIST)
053 $ST PFL,FL+PUR ;PURE FLONUMS
SEGMENT TABLES LISP.393[MAC,LSP] 01/17/78 Page 36.1
054 $ST XXP,$XM+PUR ;SLACK PURE SEGMENT (FOOEY!)
055 $ST IFS,LS+$FS ;IMPURE FREE STORAGE (LIST)
056 $ST IFX,FX ;IMPURE FIXNUMS
057 $ST IFL,FL ;IMPURE FLONUMS
058 002 041 IFN BIGNUM, $ST BN,BN ;BIGNUMS
059 $ST XXB,$XM ;SLACK SEGMENTS (IMPURE!)
060 035 080 IFE LOBITSG, $ST BIT,$XM ;BIT BLOCKS
061 $ST BPS,$XM ;BINARY PROGRAM SPACE
062 $ST NXM,$NXM ;(INITIALLY) NON-EXISTENT MEMORY
063 $ST FXP,FX+$PDLNM ;FIXNUM PDL
064 027 051 $ST XFXP,$NXM ;FOR FXP EXPANSION
065 $ST FLP,FL+$PDLNM ;FLONUM PDL
066 027 050 $ST XFLP,$NXM ;FOR FLP EXPANSION
067 $ST P,$XM ;REGULAR PDL
068 $ST XP,$NXM ;FOR P EXPANSION
069 $ST SP,$XM ;SPECIAL PDL
070 $ST XSP,$NXM ;FOR SP EXPANSION
071 $ST SCR,$NXM ;SCRATCH SEGMENTS
072 .HKILL ST.ZER
073 036 033 IFN ST+NSEGS-., WARN \.-ST,[=WRONG SEGMENT TABLE LENGTH (SHOULD BE ]\NSEGS,[)]
074 ] ;END OF IF2
075 ] ;END OF ITS
SEGMENT TABLES LISP.393[MAC,LSP] 01/17/78 Page 37
001
002
003 ;;; THE FORMAT OF THE GARBAGE COLLECTOR SEGMENT TABLE IS RATHER HAIRY, SINCE
004 ;;; THE SIZES AND POSITIONS OF ALL FIELDS IN EACH WORD ARE DEPENDENT ON THE
005 ;;; SEGMENT SIZE. THE LOW ORDER <22-<SEGLOG-5>> BITS OF EACH ENTRY CONTAIN
006 ;;; THE HIGH-ORDER BITS OF THE ADDRESS OF THE BLOCK OF BITS TO BE USED IN MARKING
007 ;;; THAT SEGMENT. (NOTE THAT THE OMITTED LOW-ORDER BITS OF THIS ADDRESS ARE
008 ;;; ZERO ANYWAY.) THESE ADDRESS BITS ARE IN THIS STRANGE RIGHT-ADJUSTED POSITION
009 ;;; FOR THE CONVENIENCE OF THE GCMARK ROUTINE (Q.V.). NOT ALL SEGMENTS HAVE
010 ;;; BIT BLOCKS; THOSE WHICH DO NOT HAVE A BIT BLOCK HAVE ZERO IN THIS FIELD.
011 ;;; TO THE LEFT OF THIS BIT BLOCK ADDRESS FIELD IS A FIELD OF <22-SEGLOG> BITS;
012 ;;; THIS CONTAINS THE NUMBER OF THE NEXT SEGMENT IN THE TABLE OF THE SAME TYPE.
013 ;;; (NOT ALL SEGMENTS ARE LINKED IN THIS WAY; THOSE SEGMENTS WHICH ARE NOT
014 ;;; LINKED TO ANOTHER ONE HAVE THIS FIELD ZERO.) THE HIGH-ORDER BIT (BIT 4.9)
015 ;;; IS ONE IFF GCMARK SHOULD MARK (NOT NECESSARILY WITH A BIT BLOCK) THE CONTENTS
016 ;;; OF THE SEGMENT. THE BIT 22 BIT POSITIONS TO THE LEFT OF THE HIGH-ORDER
017 ;;; BIT OF THE BIT BLOCK ADDRESS FIELD IS ONE IFF GCMARK SHOULD MARK FROM THE
018 ;;; CDR OF AN OBJECT IN THE SEGMENT; THIS BIT IS MEANINGFUL ONLY IF BIT 4.9
019 ;;; IS ONE. THE BIT TO THE RIGHT OF THE CDR BIT IS ONE IFF GCMARK SHOULD ALSO
020 ;;; MARK FROM THE CAR OF AN OBJECT IN THE SEGMENT; THIS BIT IS MEANINGFUL ONLY
021 ;;; IF THE CDR BIT IS ONE. THESE THREE BITS MUST BE IN THESE EXACT POSITIONS,
022 ;;; AGAIN FOR THE CONVENIENCE OF GCMARK (Q.V.). THE OTHER BITS IN EACH WORD
023 ;;; ARE SO ARRANGED AS TO USE UP FREE BITS FROM THE LEFT END OF THE WORD, PACKED
024 ;;; IN AROUND THE THREE BITS ALREADY DESCRIBED. THESE OTHER BITS INDICATE WHETHER
025 ;;; OR NOT THE SEGMENT CONTAINS VALUE CELLS, SYMBOLS, OR SARS.
026
027
028 GCBMRK==400000 ;THESE ARE ALL LEFT HALF FLAGS
029 005 042 GCBCDR==1←<22-<SEGLOG-5>-1>
030 GCBCAR==GCBCDR←-1
031
032 GCB==1,,525252 ;FOR BIT TYPEOUT MODE
033 ZZZ==400000
034 GCBFOO==0
035 004 029 IRPS NAM,X,[VC+SYM+SAR+HNK ]
036 ZZZ==ZZZ←-1
037 004 063 IFN ZZZ&GCBCDR, ZZZ==ZZZ←-2
038 004 063 GCB!NAM==ZZZ
039 004 063 IFSE X,+, GCBFOO==GCBFOO\ZZZ
040 TERMIN
041
042 037 030 IFG GCBHNK-GCBCAR, WARN [GCMARK WILL LOSE ON HUNKS]
SEGMENT TABLES LISP.393[MAC,LSP] 01/17/78 Page 38
001
002 GCST: ;GC SEGMENT TABLE
003 008 007 IFE ITS, BLOCK NSEGS ;FOR DEC-10, THE GCST TABLE IS SET UP AT RUN TIME BY INIT.
004 002 026 IFN ITS,[
005 008 007 IF1, BLOCK NSEGS
006 IF2,[
007 035 087 BTB.==BTBLKS ;LOCATION COUNTER FOR ASSIGNING BIT BLOCKS
008 $GCST ZER,,,0
009 035 080 IFN LOBITSG, $GCST BIT,,,0
010 036 033 $GCST ST,,,0
011 $GCST SYS,,,0
012 037 028 $GCST SAR,L,,GCBMRK+GCBSAR
013 037 028 $GCST VC,,,GCBMRK+GCBVC
014 $GCST XVC,,,0
015 $GCST IS2,L,,0
016 037 028 $GCST SYM,L,,GCBMRK+GCBSYM
017 $GCST XXA,L,,0
018 $GCST XXZ,,,0
019 $GCST SY2,,,0
020 $GCST PFX,,,0
021 $GCST PFS,,,0
022 $GCST PFL,,,0
023 $GCST XXP,,,0
024 037 030 $GCST IFS,L,B,GCBMRK+GCBCDR+GCBCAR
025 037 028 $GCST IFX,L,B,GCBMRK
026 037 028 $GCST IFL,L,B,GCBMRK
027 037 029 IFN BIGNUM, $GCST BN,L,B,GCBMRK+GCBCDR
028 LXXBSG==LXXASG
029 $GCST1 NXXBSG,XXB,L,,0
030 035 080 IFE LOBITSG, $GCST BIT,,,0
031 $GCST BPS,,,0
032 $GCST NXM,,,0
033 $GCST FXP,,,0
034 027 051 $GCST XFXP,,,0
035 $GCST FLP,,,0
036 027 050 $GCST XFLP,,,0
037 $GCST P,,,0
038 $GCST XP,,,0
039 $GCST SP,,,0
040 $GCST XSP,,,0
041 $GCST SCR,,,0
042 .HKILL GS.ZER
043 038 002 IFN GCST+NSEGS-., WARN \.-GCST,[=WRONG GC SEGMENT TABLE LENGTH (SHOULD BE ]\NSEGS,[)]
044 ] ;END OF IF2
045 ] ;END OF IFN ITS
046
047 PAGEUP
048
049 036 033 SPCTOP ST,,[SEGMENT TABLE]
050
BEGINNING OF PURE LISP SYSTEM CODE LISP.393[MAC,LSP] 01/17/78 Page 39
001
002
003 10$ $HISEG
004 10$ HILOC==. ;ORIGIN OF HIGH SEGMENT
005 10% SPCBOT SYS
006 SA$ PSGNAM: 0 ;THESE LOCATIONS FOR SAIL HISEG VALIDATION
007 SA$ PSGDEV: 0
008 SA$ PSGEXT: 0
009 SA$ PSGPPN: 0
010
011 SUBTTL BEGINNING OF PURE LISP SYSTEM CODE
012
013 172 020 PGBOT ERR
014
015 ;;; THESE CONSTANTS ARE BUILT INTO THE COMPILER.
016 ;;; THEY MUST BE DEFINED HERE FOR THE BENEFIT OF THE PUSHN MACRO.
017 .SEE PUSHN
018
019 066 009 NNPUSH==:20 .SEE NPUSH
020 N0PUSH==:10 .SEE 0PUSH
021 N0.0PUSH==:10 .SEE 0.0PUSH
022
023
024 BPURPG==:. ;BEGINNING OF PURE PAGES FOR INSERT FILE PAGE AND PURIFY
025 $$$NIL: 777300,,VNIL ;SYMBOL BLOCK FOR NIL
026 0,,$$NIL ;ALWAYS KEEP ON FIRST PURE SYSTEM PAGE
027
028 022 059 $INSRT ERROR ;ERROR MSGS AND HANDLERS
029
030 ;;; ERROR FILE HAS DEFINITION FOR BEGFUN
031
032 022 059 PGTOP ERR,[ERROR HANDLERS AND MESSAGES]
033
034 PGBOT TOP
035
036
037 030 050 LISPGO: SETOM AFILRD ;START HERE ON }G'ING
038 012 021 IT$ .SUSET [.S40ADDR,,[TWENTY,,FORTY]] ;SET .40ADDR
039 030 002 IT$ .SUSET [.RSNAM,,IUSN] ;GET INITIAL SNAME
040 030 024 10$ SETOM UPCOK ;TELL LISP ITS OK TOO
041 011 065 JRST 2,@LISPSW ;ZEROS OUT PROCESSOR FLAGS, AND TRANSFERS TO LISP
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 40
001
002 SUBTTL BASIC TOP LEVEL LOOP
003
004 ;;; (DEFUN STANDARD-TOP-LEVEL ()
005 ;;; (PROG (↑Q ↑W ↑R EVALHOOK BASE IBASE ...)
006 ;;; ERROR ;ERRORS, UNCAUGHT THROWS, ETC. COME HERE
007 ;;; ↑G ;↑G QUITS COME HERE
008 ;;; (RESET-BOUND-VARIABLES-AND-RESTORE-PDLS)
009 ;;; (SETQ ↑Q NIL)
010 ;;; (SETQ ↑W NIL)
011 ;;; (SETQ EVALHOOK NIL)
012 ;;; (NOINTERRUPT NIL)
013 ;;; (DO-DELAYED-TTY-AND-ALARMCLOCK-INTERRUPTS)
014 ;;; ;RECALL THAT ERRORS DO (SETQ // ERRLIST)
015 ;;; (MAPC (FUNCTION EVAL) //)
016 ;;; (OR (TOP-LEVEL-LINMODE) (TERPRI))
017 ;;; (DO ((PRT '* *))
018 ;;; (NIL) ;DO FOREVER (UNTIL ERROR OR ↑G QUIT)
019 ;;; (SETQ * (COND ((STATUS TOPLEVEL)
020 ;;; (EVAL (STATUS TOPLEVEL)))
021 ;;; (T (TOP-LEVEL-PRINT PRT)
022 ;;; (TOP-LEVEL-TERPRI)
023 ;;; (TOP-LEVEL-EVAL (TOP-LEVEL-READ))))))))
024
025 027 061 LSPRET: MOVE P,C2 ;RETURN TO TOP LEVEL BY ERR, THROW, AND LISP ERRORS
026 049 002 PUSHJ P,ERRPOP
027 045 004 LSPRT1: JSP T,TLVRSS ;RETURN TO TOP BY ↑G
028 046 006 JSP A,ERINIT
029 131 052 Q$ SETZ A, ;FOR QIO, NEED A NIL IN A FOR CHECKU
030 069 018 PUSHJ P,CHECKU ;CHECK FOR DELAYED "REAL TIME" INTS
031 MOVEI A,QOEVAL
032 SKIPE B,VIQUOTIENT ;SHADES OF ERRLIST!!!
033 CALLF 2,QMAPC
034 043 037 HACENT: PUSH P,FLP .SEE PDLCHK
035 PUSH P,FXP
036 PUSH P,SP
037 040 044 PUSH P,LISP1 ;ENTRY FROM LIHAC
038 PUSH P,[Q.]
039 030 043 Q% SKIPN LINMODE
040 044 015 Q$ JSP F,LINMDP
041 PUSHJ P,ITERPRI
042 040 047 JRST LISP2 ;KLUDGE SO AS NOT TO MUNG *
043
044 040 044 LISP1: PUSH P,LISP1 ;******* BASIC TOP LEVEL LOOP *******
045 HRRZM A,V. ;THE SYMBOL * GETS AS ITS VALUE THE
046 PUSH P,A
047 045 004 LISP2: JSP T,TLVRSS ; RESULT OF THE LAST TOP-LEVEL EVAL
048 POP P,B
049 SKIPN A,TLF
050 040 057 JRST LISP2A
051 HRRZ TT,-3(P)
052 181 046 HRRZ D,-2(P)
053 071 024 HRRZ R,-1(P)
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 40.1
054 043 037 PUSHJ P,PDLCHK ;CHECK PDL LEVELS FOR ERRORS
055 152 043 JRST EVAL
056
057 LISP2A: MOVEI A,(B)
058 044 038 PUSHJ P,TLPRINT ;PRINT THE LAST OUTPUT FORM
059 HRRZ TT,-3(P)
060 181 046 HRRZ D,-2(P)
061 071 024 HRRZ R,-1(P)
062 043 037 PUSHJ P,PDLCHK ;CHECK PDL LEVELS FOR ERRORS
063 041 028 PUSHJ P,TLTERPRI ;OUTPUT A TERPRI
064 042 016 PUSHJ P,TLREAD ;READ AN INPUT FORM
065 043 016 JRST TLEVAL ;EVALUATE IT, RETURNING TO LISP1
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 41
001
002 002 048 IFN QIO,[
003 ;;; (DEFUN STANDARD-IFILE ()
004 ;;; (COND ((OR (NULL ↑Q) (EQ INFILE T)) TYI)
005 ;;; (T INFILE)))
006
007 STDIFL: HRRZ A,VINFILE
008 SKIPE TAPRED
009 CAIN A,TRUTH
010 HRRZ A,V%TYI
011 POPJ P,
012 ] ;END OF IFN QIO
013
014 ;;; (DEFUN TOP-LEVEL-TERPRI ()
015 ;;; ((LAMBDA (IFILE)
016 ;;; (AND (TTYP FILE)
017 ;;; (TOP-LEVEL-TERPRI-X
018 ;;; (STATUS LINMODE IFILE)
019 ;;; (STATUS TTYCONS IFILE))))
020 ;;; (STANDARD-IFILE)))
021 ;;;
022 ;;; (DEFUN TOP-LEVEL-TERPRI-X (LM OFILE)
023 ;;; (AND OFILE
024 ;;; (COND ((EQ OFILE TYO)
025 ;;; (TERPRI (CONS T (AND ↑R OUTFILES))))
026 ;;; (T (OR LM ↑W (TERPRI OFILE))))))
027
028 TLTERPRI:
029 209 011 IFE QIO, JRST TERPRI
030 002 048 IFN QIO,[
031 041 007 PUSHJ P,STDIFL ;GET STANDARD INPUT FILE
032 MOVE F,TTSAR(A)
033 TLNN F,TTS.TY
034 POPJ P,
035 018 016 MOVEI TT,FT.CNS
036 MOVE AR1,@TTSAR(A)
037 ;TOP-LEVEL-TERPRI-X; TTYCONS IN AR1, FBT.LN IN F
038 059 031 TLTERX: JUMPE AR1,CPOPJ ;EXIT IF NO TTYCONS FILE
039 CAME AR1,V%TYO
040 041 045 JRST TLTER1
041 SKIPE AR1,TAPWRT ;IF SAME AS TYO, TERPRI TO
042 HRRZ AR1,VOUTFILES ; STANDARD OUTPUT FILES
043 209 011 JRST TERP1
044
045 TLTER1: TLNN F,FBT.LN ;IF INPUT FILE NOT IN LINMODE,
046 SKIPE TTYOFF ; AND ↑W IS NOT SET,
047 POPJ P, ; TERPRI TO JUST THE TTYCONS FILE
048 TLO AR1,-1
049 209 011 JRST TERP1
050 ] ;END OF IFN QIO
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 42
001
002 ;;; (DEFUN TOP-LEVEL-READ ()
003 ;;; (DO ((EOF (LIST 'TLRED1)) (IFILE) (FORM))
004 ;;; (NIL) ;DO UNTIL RETURN
005 ;;; (SETQ IFILE (STANDARD-IFILE))
006 ;;; (SETQ FORM (COND (READ (FUNCALL READ EOF)) (T (READ EOF))))
007 ;;; (COND ((NOT (EQ FORM EOF))
008 ;;; (AND (NULL READ)
009 ;;; (ATOM FORM)
010 ;;; (IS-A-SPACE (TYIPEEK))
011 ;;; (TYI))
012 ;;; (RETURN FORM)))
013 ;;; (COND ((NOT (TTYP IFILE)) (TERPRI T))
014 ;;; (T (TOP-LEVEL-TERPRI-X NIL (STATUS TTYCONS IFILE))))))
015
016 TLREAD:
017 002 048 IFE QIO, PUSHJ P,IREAD
018 002 048 IFN QIO,[
019 041 007 PUSHJ P,STDIFL ;GET STANDARD INPUT FILE AS OF
020 PUSH P,AR1 ; *BEFORE* THE READ, AND SAVE IT
021 042 024 REPEAT 2, PUSH P,[TLRED1] ;ONCE FOR RANDOM EOF VALUE
022 MOVNI T,1
023 209 011 JRST IREAD1 ;READ THE FORM (POSSIBLY USING USER'S READ)
024 TLRED1: POP P,B
025 042 024 CAIE A,TLRED1
026 042 042 JRST SPCFLS
027 MOVE TT,TTSAR(B) ;SIMPLY TERPRI ON EOF IF APPROPRIATE
028 TLNE TT,TTS.TY
029 042 034 JRST TLRED2
030 131 052 SETZ AR1,
031 PUSHJ P,TERP1
032 042 016 JRST TLREAD
033
034 018 016 TLRED2: HRRI TT,FT.CNS
035 MOVEI AR1,NIL
036 MOVE AR1,@TTSAR(B)
037 131 052 SETZ F,
038 041 038 PUSHJ P,TLTERX
039 042 016 JRST TLREAD
040
041 ] ;END OF IFN QIO
042 SPCFLS: SKIPE VOREAD
043 POPJ P,
044 PUSH P,A
045 080 005 PUSHJ P,ATOM
046 059 035 JUMPE A,POPAJ
047 MOVEI T,0 ;PEEL OFF A SPACE, IF THAT
048 110 006 PUSHJ P,TYIPEEK+1 ;WAS WHAT TERMINATED THE ATOM
049 MOVE T,VREADTABLE
050 MOVE TT,@TTSAR(T)
051 MOVEI T,0
052 TLNE TT,100000 ;WORTHLESS CHAR, OR SPACE ETC.
053 PUSHJ P,%TYI
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 42.1
054 059 035 JRST POPAJ
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 43
001
002 ;;; (DEFUN TOP-LEVEL-EVAL (FORM)
003 ;;; (SETQ - FORM)
004 ;;; ((LAMBDA (+)
005 ;;; (PROG2 NIL
006 ;;; (EVAL +)
007 ;;; (AND (OR (CAR NIL) (CDR NIL))
008 ;;; (ERROR '|NIL CLOBBERED|
009 ;;; (PROG2 NIL
010 ;;; (CONS (CAR NIL) (CDR NIL))
011 ;;; (RPLACA NIL NIL)
012 ;;; (RPLACD NIL NIL))
013 ;;; 'FAIL-ACT))))
014 ;;; (PROG2 NIL + (SETQ + -))))
015
016 TLEVAL: MOVEM A,VIDIFFERENCE ;THE SYMBOL - GETS THE TYPED-IN
017 MOVEI B,(A) ; EXPRESSION AS ITS VALUE AND KEEPS IT
018 EXCH B,VIPLUS ;THE SYMBOL + GETS THE THE TYPED-IN
019 048 005 JSP T,SPECBIND ; EXPRESSION AS ITS VALUE, BUT NOT
020 0 B,VIPLUS ; UNTIL AFTER IT HAS BEEN EVALUATED.
021 152 043 CEVAL: PUSHJ P,EVAL ;SPECBINDING IT ENSURES THAT IT WILL
022 049 033 JUMPE UNBIND ; GET THIS VALUE IN SPITE OF ERRORS.
023 164 094 PUSH P,CUNBIND
024 NILBAD: PUSH P,A ;FOO! WELL, ERROR HANDLING SAVES
025 059 036 PUSH P,CPOPAJ ;ALL ACS IN CASE YOU WANT TO CONTINUE
026 MOVS A,NIL
027 131 052 CSETZ: SETZ NIL, ;NIL=0! CAN USE THIS AS A CONSTANT WORD
028 051 010 PUSHJ P,ACONS
029 %FAC [SIXBIT \NIL CLOBBERED!\]
030
031
032 ;;; PUSHJ HERE WITH PROPER VALUES FOR THE RIGHT HALVES
033 ;;; OF <FLP, FXP, SP> IN <TT, D, R>. WILL ERROR OUT
034 ;;; IF THEY DON'T MATCH UP. USED FOR TRAPPING GROSS
035 ;;; ERRORS IN THE SYSTEM.
036
037 131 052 PDLCHK: SETZ T,
038 CAIE TT,(FLP)
039 MOVEI T,QFLPDL
040 181 046 CAIE D,(FXP)
041 MOVEI T,QFXPDL
042 071 024 CAIE R,(SP)
043 MOVEI T,QSPECPDL
044 059 031 JUMPE T,CPOPJ ;EVERYBODY HAPPY?
045 PDLCRP: MOVEI A,(T) ;NO, PDL CRAP-OUT
046 022 059 LER3 [SIXBIT \OUT OF PHASE (SYSTEM ERROR)!\]
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 44
001
002 002 048 IFN QIO,[
003
004 ;;; (DEFUN TOP-LEVEL-LINMODE ()
005 ;;; ((LAMBDA (IFILE)
006 ;;; (AND (TTYP IFILE)
007 ;;; (STATUS LINMODE IFILE)))
008 ;;; (STANDARD-IFILE)))
009
010 ;;; SKIP IF INPUT FILE IN LINE MODE.
011 ;;; ALSO LEAVE OUTFILES IN AR1 AND READTABLE IN AR2A.
012 ;;; FURTHERMORE LEAVE INPUT FILE IN C (SEE TLPRINT).
013 ;;; ALSO LEAVE TTSAR OF INPUT FILE IN T.
014
015 068 059 LINMDP: JSP T,GTRDTB
016 035 006 HRRZ C,VINFILE
017 SKIPE TAPRED
018 035 006 CAIN C,TRUTH
019 035 006 HRRZ C,V%TYI
020 018 018 MOVEI TT,F.MODE
021 035 006 MOVE T,@TTSAR(C)
022 SKIPE AR1,TAPWRT
023 HRRZ AR1,VOUTFILES
024 TLNN T,FBT.LN ;ONLY A TTY CAN HAVE LINMODE SET
025 209 011 JRST (F) ;TYPICALLY RETURN TO AN ITERPRI
026 209 011 JRST 1(F) ; OR SKIP OVER IT
027
028 ] ;END OF IFN QIO
029
030
031 ;;; (DEFUN TOP-LEVEL-PRINT (PRT)
032 ;;; (OR (AND (TOP-LEVEL-LINMODE)
033 ;;; (EQ (STATUS TTYCONS (STANDARD-IFILE)) TYO))
034 ;;; (TERPRI))
035 ;;; (COND (PRIN1 (FUNCALL PRIN1 PRT)) (T (PRIN1 PRT)))
036 ;;; (TYO 40))
037
038 TLPRINT: PUSH P,A ;TOP-LEVEL PRINT
039 030 043 Q% SKIPN LINMOD
040 Q% PUSHJ P,ITERPRI
041 002 048 IFN QIO,[
042 044 015 JSP F,LINMDP ;LEAVES INPUT FILE IN C
043 044 048 JRST TLPR1
044 018 016 MOVEI TT,FT.CNS
045 035 006 HRRZ C,@TTSAR(C)
046 TLNE T,TTS.TY
047 035 006 CAME C,V%TYO
048 TLPR1: PUSHJ P,ITERPRI
049 ] ;END OF IFN QIO
050 MOVE A,(P)
051 044 056 PUSHJ P,IPRIN1
052 MOVEI A,40
053 PUSHJ P,TYO
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 44.1
054 059 035 JRST POPAJ
055
056 IPRIN1:
057 Q% SKIPN VPRIN1
058 Q$ SKIPN V%PR1
059 209 011 JRST PRIN1
060 Q% JCALLF 1,@VPRIN1
061 Q$ JCALLF 1,@V%PR1
BASIC TOP LEVEL LOOP LISP.393[MAC,LSP] 01/17/78 Page 45
001
002 ;;; TOP LEVEL VARIABLE SETTINGS
003
004 022 019 TLVRSS: MOVE A,[PNBUF,,PNBUF+1]
005 022 019 SETZM PNBUF
006 022 019 BLT A,PNBUF+LPNBUF-1
007 020 030 TLVRS1: PUSH P,EOFRTN
008 020 018 Q% MOVE A,[INTSV,,INTSV+1]
009 020 018 Q% SETZM INTSV
010 020 028 Q$ MOVE A,[ERRTN,,ERRTN+1]
011 020 028 Q$ SETZM ERRTN
012 020 028 BLT A,ERRTN+LEP1-1
013 020 033 SETOM ERRSW
014 020 034 Q% SETOM RRDF
015 ;Q$ SETZM BFPRDP
016 020 030 POP P,EOFRTN
017 024 067 SETZB NIL,PANICP
018 032 032 SETZB A,PSYMF
019 021 002 SETZB B,EXPL5
020 035 006 SETZB C,PA3
021 Q% SETZB AR1,MKNM3
022 Q$ SETZB AR1,RDLARG
023 SETZB AR2A,QF1SB
024 SETZM ARGLOC
025 SETZM ARGNUM
026 209 011 JRST (T)
027
028
029 005 005 IFN D10,[
030 SIXJBN: PJOB TT,
031 IDIVI TT,100.
032 181 046 IDIVI D,10.
033 LSH TT,14
034 181 046 LSH D,6
035 181 046 ADDI TT,(D)
036 071 024 ADDI TT,202020(R)
037 HRLI TT,(SIXBIT /LSP/)
038 030 020 MOVSM TT,D10NAM ;SAVE ###LSP AS TEMP FILE NAME
039 POPJ P,
040 ] ;END OF IFN D10
INITIALIZATION ON ↑G QUIT AND ERRORS LISP.393[MAC,LSP] 01/17/78 Page 46
001
002 SUBTTL INITIALIZATION ON ↑G QUIT AND ERRORS
003 ;;; ERINIT RESETS PDL POINTERS, THEN FALLS INTO ERINI0.
004 ;;; ERINI0 RESETS VARIOUS VARIABLES AND PERFORMS CLEANUP.
005
006 ERINIT:
007 002 048 IFN QIO,[
008 ;DISABLE INTERRUPT SYSTEM
009 064 009 IT$ .SUSET [.SPICLR,,R70]
010 020 015 10$ WARN [D10 INT DISABLE?]
011 020 015 20$ WARN [D20 INT DISABLE?]
012 ] ;END OF IFN QIO
013 ERINIX: ;ENTER HERE IF INTERRUPTS ALREADY DISABLED
014 005 005 IFN D10,[
015 027 061 MOVE P,C2 ;SET UP PDL POINTERS
016 027 063 MOVE FXP,FXC2
017 027 062 MOVE FLP,FLC2
018 027 064 MOVE SP,SC2
019 ] ;END OF IFN D10
020 005 006 IFN ITS+D20,[
021 Q% PIOF
022 027 028 MOVE T,PDLFL1 ;CONTAINS <- # OF PDL PAGES,,# OF 1ST PDL PAGE>
023 047 101 .CALL PDLFLS ;FLUSH ALL PDL PAGES
024 .VALUE
025 MOVE T,[$NXM,,QRANDOM]
026 027 029 MOVE TT,PDLFL2 ;CONTAINS <- # OF PDL SEGS,,# OF 1ST PDL SEG>
027 036 033 MOVEM T,ST(TT) ;UPDATE SEGMENT TABLE TO REFLECT
028 AOBJN TT,.-1 ; LOSS OF PDL PAGES
029 027 028 HRRZ T,PDLFL1
030 ROT T,-4
031 ADDI T,(T)
032 ROT T,-1
033 TLC T,770000
034 034 035 ADD T,[450200,,PURTBL]
035 131 052 SETZ D,
036 027 028 HLRE TT,PDLFL1
037 ERINI8: TLNN T,730000
038 TLZ T,770000
039 181 046 IDPB D,T
040 046 037 AOJL TT,ERINI8
041 Q% MOVEI AR2A,(A)
042 IRP Z,,[P,FLP,FXP,SP]
043 Q% MOVEI A,Z
044 Q$ MOVEI F,Z
045 027 061 MOVE Z,C2-P+Z ;CAUSE ONE PDL PAGE
046 181 046 MOVEI D,1(Z) ; FOR Z TO EXIST
047 007 034 ANDI D,PAGMSK
048 016 027 JSR PDLSTH .SEE PDLST0
049 TERMIN
050 Q% MOVEI A,(AR2A)
051 027 054 ERIN8G: MOVE T,[XPDL,,ZPDL]
052 027 057 BLT T,ZSPDL
053 ] ;END OF IFN ITS+D20
INITIALIZATION ON ↑G QUIT AND ERRORS LISP.393[MAC,LSP] 01/17/78 Page 46.1
054 ERINI0: SETZB NIL,TAPRED ;INITIALIZATION AFTER PDL SETUP
055 015 019 SETZM NOQUIT
056 SETZM FASLP
057 021 055 IFN USELESS, SETZM TYOSW
058 015 012 SETZM INTFLG
059 028 010 SETZM INTAR
060 SETZM VEVALHOOK
061 Q% SETZM TYIMAN
062 Q% SETZM TMBBC
063 Q% SETZM RDTYBF
064 002 048 IFN QIO,[
065 024 064 SETZM GCFXP ;NON-ZERO WOULD MEAN INSIDE GC
066 020 035 SETZM BFPRDP
067 028 050 MOVE T,[-LINTPDL,,INTPDL]
068 028 050 MOVEM T,INTPDL
069 MOVEI T,$DEVICE ;RESTORE READER'S LITTLE MEN
070 MOVEM T,TYIMAN
071 MOVEI T,UNTYI
072 MOVEM T,UNTYIMAN
073 ;; MOVEI T,READP
074 ;; MOVEM T,READPMAN
075 ;; MOVEI T,UNRD
076 ;; MOVEM T,UNREADMAN
077 ] ;END OF IFN QIO
078
079 ;FALLS THROUGH
INITIALIZATION ON ↑G QUIT AND ERRORS LISP.393[MAC,LSP] 01/17/78 Page 47
001
002 ;FALLS IN
003
004 029 009 ERINI2: SKIPL MUNGP ;MAYBE NEED TO UNMUNG SYMBOLS AND SARS
005 047 037 JRST ERINI6
006 026 011 MOVE D,SYSGLK
007 047 028 ERINI5: JUMPE D,ERIN5A
008 181 046 MOVEI F,(D)
009 005 042 LSH F,SEGLOG
010 008 004 HRLI F,-SEGSIZ
011 038 002 LDB D,[SEGBYT,,GCST(D)]
012 071 024 ERIN5C: MOVSI R,1
013 071 024 ANDCAB R,(F) ;UNMUNGS THE SYMBOL HEADER, IF NECESSARY
014 071 024 HLRZS R
015 071 024 HRRZ R,(R) ;GET ADDR OF VALUE CELL
016 071 024 CAIL R,BVCSG
017 008 004 CAIL R,BVCSG+<NXVCSG+1>*SEGSIZ
018 209 011 JRST .+2
019 047 025 JRST ERIN5D
020 071 024 CAIL R,BPURFS
021 071 024 CAIL R,PFSLAST
022 209 011 JRST .+2
023 047 025 JRST ERIN5D
024 071 024 HRRZS (R) ;UNMUNGS THE VALUE CELL, IF STORED IN LIST SPACE
025 047 012 ERIN5D: AOBJN F,ERIN5C
026 047 007 JRST ERINI5
027
028 047 090 ERIN5A: MOVE F,[SARTOB,,B]
029 047 097 BLT F,LPROGZ
030 026 013 MOVE D,SASGLK
031 047 037 ERIN5B: JUMPE D,ERINI6
032 181 046 MOVEI F,(D)
033 005 042 LSH F,SEGLOG
034 008 004 HRLI F,-SEGSIZ/2
035 038 002 LDB D,[SEGBYT,,GCST(D)]
036 047 092 JRST SATOB1
037 029 009 ERINI6: HRRZS MUNGP
038 029 009 SKIPN MUNGP ;UNMUNG VALUE CELLS (SEE ALIST)
039 047 047 JRST ERIN6A
040 MOVEI F,BVCSG
041 023 063 SUB F,EFVCS
042 HRLI F,(F)
043 HRRI F,BVCSG
044 HRRZS (F)
045 AOBJN F,.-1
046 029 009 SETZM MUNGP
047 020 028 ERIN6A: MOVE B,[ERRTN,,ERRTN+1]
048 020 028 SETZM ERRTN
049 020 046 BLT B,UIRTN
050 020 034 Q% SETOM RRDF
051 020 033 SETOM ERRSW
052 013 011 MOVSI B,-NSFC
053 223 007 ERINI3: MOVE C,SFXTBI(B) ;RESTORE CLOBBERED LOCATIONS
INITIALIZATION ON ↑G QUIT AND ERRORS LISP.393[MAC,LSP] 01/17/78 Page 47.1
054 223 004 MOVEM C,@SFXTBL(B)
055 047 053 AOBJN B,ERINI3
056 015 056 Q% SETZM WAITFL ;IS EVERYBODY HAPPY?
057 TLZ A,-1
058 ;ENABLE THE INTERRUPT SYSTEM
059 002 048 IFE QIO,[
060 002 026 IFN ITS,[
061 015 046 .SUSET [.SMASK,,IMASK] ;SET INTERRUPT MASK
062 064 009 .SUSET [.SDF1,,R70] ;RESET DEFER WORDS
063 064 009 .SUSET [.SDF2,,R70]
064 ] ;END OF IFN ITS
065 005 005 IFN D10,[
066 177 016 MOVEI TT,INT0
067 MOVEM TT,.JBAPR
068 MOVEI TT,630000
069 APRENB TT,
070 177 044 MOVEI T,TTYINT ;REENTER COMMAND WILL START US
071 MOVEM T,.JBREN ; AT TTYINT (TO READ INTERRUPT CHAR)
072 030 024 SETOM UPCOK ;ENABLE SUCH "INTERRUPTS"
073 ] ;END OF IFN D10
074 PION
075 ] ;END OF IFE QIO
076 002 048 IFN QIO,[
077 002 026 IFN ITS,[
078 015 046 .SUSET [.SMASK,,IMASK] ;RESTORE INTERRUPT ENABLE MASKS
079 015 047 .SUSET [.SMSK2,,IMASK2]
080 064 009 .SUSET [.SDF1,,R70] ;RESET DEFER WORDS
081 064 009 .SUSET [.SDF2,,R70]
082 064 014 .SUSET [.SPICLR,,XC-1] ;ENABLE INTERRUPT SYSTEM
083 ] ;END OF IFN ITS
084 005 005 10$ WARN [D10 INTERRUPT RE-ENABLE?]
085 005 006 20$ WARN [D20 INTERRUPT RE-ENABLE?]
086 ] ;END OF IFN QIO
087 209 011 JRST (A) ;RETURN TO CALLER
088
089
090 SARTOB: ;TURN OFF MARK BITS IN SARS
091 OFFSET B-.
092 047 095 SATOB1: ANDCAM SATOB7,TTSAR(F)
093 047 031 AOBJP F,ERIN5B
094 047 092 AOJA F,SATOB1
095 SATOB7:
096 TTS<GC>,,
097 LPROGZ==.-1
098 OFFSET 0
099 047 095 .HKILL SATOB1 SATOB7
100
101 131 052 PDLFLS: SETZ
102 SIXBIT \CORBLK\
103 1000,,0 ;DELETE PAGES...
104 1000,,-1 ; FROM MYSELF...
105 131 052 SETZ T ; AND HERE'S HOW MANY AND WHERE!
SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 48
001
002 SUBTTL SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES
003
004 JFCL ;HISTORICAL LOSS -- EVENTUALLY FLUSH
005 014 066 SPECBIND: MOVEM SP,SPSV ;0 0,FOO MEANS FOO IS ADDR OF SVC TO BE BOUND TO NIL, SAVES D
006 071 024 SPEC1: LDB R,[271500,,(T)] ;0 N,FOO MEANS SVC FOO TO BE BOUND TO CONTENTS OF ACC N
007 048 037 JUMPE R,SPEC4
008 071 024 CAILE R,17 ;7←41 M,FOO MEANS BIND FOO TO -M(P)
009 048 042 JRST SPEC3 ;OTHERWISE, IS PDP10 INSTRUCTION, SO EXIT
010 071 024 SPEC2: HRRZ R,(R) ;NOTE WELL! NCOMPLR DEPENDS ON THE FACT
011 027 023 CAML R,NPDLL ; THAT R = TT+2 = NUMVALAC+2
012 027 024 CAMLE R,NPDLH
013 048 037 JRST SPEC4
014 PUSH FXP,T
015 071 024 MOVEI T,(R)
016 005 042 LSH T,-SEGLOG
017 036 033 SKIPL T,ST(T) ;NMK1 WILL WANT TYPE BITS IN T
018 TLNN T,$PDLNM ;SKIP IF PDL NUMBER
019 048 036 JRST SPEC5
020 HRR T,(FXP)
021 071 024 LDB R,[271500,,(T)] ;RECOMPUTE ADDRESS OF FROB
022 071 024 CAIG R,17
023 048 026 JRST SPEC6
024 071 024 TRC R,16000#-1
025 071 024 ADDI R,1(P)
026 014 010 SPEC6: PUSHJ P,ABIND3 ;TEMPORARILY CLOSE THE BIND BLOCK
027 PUSH P,A
028 071 024 HRRZ A,(R)
029 094 023 PUSHJ P,NMK1
030 071 024 MOVEM A,(R) ;CLOBBER LOC OF FROB WITH NEW NUMBER
031 071 024 CAIN R,A ;GRUMBLE
032 MOVEM A,(P)
033 064 009 SUB SP,R70+1 ;SO RE-OPEN THE BIND-BLOCK
034 071 024 MOVEI R,(A) ;THEREBY INHIBITING INTERRUPTS
035 POP P,A
036 SPEC5: POP FXP,T
037 071 024 SPEC4: EXCH R,@(T)
038 071 024 HRL R,(T)
039 071 024 PUSH SP,R
040 048 006 AOJA T,SPEC1
041
042 071 024 SPEC3: CAIGE R,16000
043 014 016 JRST SPECX
044 071 024 TRC R,16000#-1 ;RH OF R NOW HAS N
045 071 024 ADDI R,1(P) ;SPECBINDING OFF PDL
046 048 010 JRST SPEC2
SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 49
001
002 027 068 ERRPOP: SKIPA TT,ZSC2 ;TOTALLY POP OFF SPECPDL FOR ERRORS
003 UBD0: TLZA TT,-1 ;POP SPECPDL TO PLACE SPECIFIED IN TT
004 SETOM (TT) ;ERRPOP MUST SETOM - SEE UBD4
005 UBD: CAIL TT,(SP) ;RESTORE THE SPDL BY RESTORING VALUES
006 014 005 JRST UNBND2 ; UNTIL (SP) MATCHES (TT)
007 071 024 POP SP,R
008 071 024 HLRZ D,R
009 071 024 TLZ R,-1
010 027 068 CAMGE R,ZSC2
011 049 019 JRST UBD3
012 071 024 CAIG R,(SP)
013 049 005 IFE FUNAFL, JRST UBD
014 002 046 IFN FUNAFL,[
015 049 023 JRST UBD4
016 181 046 SKIPN D
017 006 121 .LOSE ;SOMEBODY SCREWED THE SPECPDL - HELP!!!
018 ] ;END OF IFN FUNAFL
019 071 024 UBD3: HRRZM R,(D)
020 049 005 UBD1: JRST UBD
021
022 002 046 IFN FUNAFL,[
023 181 046 UBD4: HLRZ D,(SP)
024 049 005 JUMPN D,UBD ;AMONG OTHER THINGS, ERRPOP'S SETOM MAKES THIS JUMP
025 PUSH FXP,T ;MUST SAVE T
026 071 024 MOVEI T,(R)
027 136 029 PUSHJ P,AUNBN0 ;FOUND A FUNARG BINDING BLOCK
028 POP FXP,T ; - USE SPECIAL ROUTINE TO UNBIND IT
029 049 005 JRST UBD
030 ] ;END OF IFN FUNAFL
031
032
033 UNBIND: POP SP,T
034 020 053 MOVEM TT,UNBND3 ;HORRIBLE HACK TO SAVE AC TT. THINK ABOUT THIS SOME DAY
035 UNBND0: TLZ T,-1 ;AUNBIND ENTERS HERE
036 UNBND1: CAIN T,(SP)
037 014 005 JRST UNBND2
038 POP SP,TT
039 MOVSS TT
040 HLRZM TT,(TT)
041 049 036 JRST UNBND1
SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 50
001
002
003 ;;; BIND, AND MAKE-VALUE-CELL ROUTINES.
004 ;;; PUSHJ P,BIND WITH SYMBOL IN A, VALUE IN AR1.
005 ;;; USES ONLY A, TT; MUST SAVE T
006 ;;; JSP TT,MAKVC WITH AN ATOMIC SYMBOL ON THE PDL (WHICH IS POPPED)
007 ;;; AND THE VALUE IN B. RETURNS ADDRESS OF NEW VALUE CELL IN A.
008 ;;; (LATTER CROCK FOR BIND1 ONLY). USES ONLY A,B,TT.
009
010 BIND: SKIPN TT,A
011 050 023 JRST BIND5
012 HLRZ A,(A)
013 XCTPRO
014 HRRZ A,(A)
015 NOPRO
016 CAIN A,SUNBOUND
017 050 026 JRST BIND1
018 BIND4: PUSH SP,(A)
019 HRLM A,(SP)
020 STQPUR: HRRZM AR1,(A)
021 POPJ P,
022
023 BIND5: MOVEI A,VNIL ;ALLOW PURPGI TRAP TO WORK JUST
024 050 018 CBIND4: JRST BIND4 ;LIKE FOR SETQING T
025
026 050 024 BIND1: PUSH P,CBIND4 ;SET UP FOR CALL TO MAKVC
027 PUSH P,B
028 PUSH P,TT
029 MOVEI B,QUNBOUND
030 050 034 JSP TT,MAKVC
031 POPBJ: POP P,B
032 050 031 CPOPBJ: POPJ P,POPBJ
033
034 MAKVC: PUSH FXP,TT ;SAVE RETURN ADDR
035 226 035 SPECPRO INTZAX
036 023 065 MAKVC0: SKIPN A,FFVC
037 050 048 JRST MAKVC3
038 023 065 EXCH B,@FFVC
039 XCTPRO
040 023 065 HRRZM B,FFVC
041 NOPRO
042 MAKVC1: HLRZ B,@(P) ;POINTER TO SYMBOL HEADER IS ON STACK
043 PURTRAP MAKVC9,B, HRRM A,(B)
044 064 009 MAKVCX: SUB P,R70+1 ;POP POINTER, RETURN ADDRESS OF VALUE CELL
045 POPJ FXP,
046
047 005 005 IFN D10,[
048 073 012 MAKVC3: PUSHJ P,CONS1
049 023 066 SETOM ETVCFLSP
050 050 042 JRST MAKVC1
051 ] ;END OF IFN D10
052
VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 51
001
002 SUBTTL VARIOUS ODDBALL CONSERS
003
004 002 041 IFN BIGNUM,[
005 022 040 C1CONS: EXCH T,YAGDBT
006 074 015 JSP T,FWCONS
007 022 040 EXCH T,YAGDBT ;FALL INTO ACONS
008 ] ;END OF IFN BIGNUM
009 BAKPRO
010 023 014 ACONS: SKIPN FFS ;THIS IS A CONS LIKE XCONS
011 PUSHJ P,AGC ;BUT USES ONLY ACCUMULATOR A
012 MOVSS A ;SWAP HALVES OF A, THEN
013 226 036 SPECPRO INTACX
014 023 014 EXCH A,@FFS ;CONS WHOLE WORD FROM A
015 XCTPRO
016 023 014 EXCH A,FFS
017 NOPRO
018 POPJ P,
019
020 002 041 IFN BIGNUM,[
021
022 BAKPRO
023 BGNMAK: ;MAKE A POSITIVE BIGNUM (SAME AS BNCONS)
024 023 020 BNCONS: SKIPN FFB ;BIGNUM CONSER
025 PUSHJ P,AGC
026 023 020 EXCH A,@FFB
027 XCTPRO
028 023 020 EXCH A,FFB
029 NOPRO
030 POPJ P,
031 ] ;END OF IFN BIGNUM
VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 52
001
002 ;;; EXPLODEC ARGUMENT IN A (WITH BASE=10., *NOPOINT=T),
003 ;;; AND RETURN A SIXBIT WORD IN TT. CLOBBERS ALL ACS.
004
005 SIXMAK: MOVEI B,IN0+10.
006 048 005 JSP T,SPECBIND
007 0 B,VBASE
008 0 B,V.NOPOINT
009 MOVSI TT,(SIXBIT \@\)
010 020 054 MOVEM TT,SIXMK2
011 020 054 MOVE AR1,[440600,,SIXMK2]
012 052 017 HRROI R,SIXMK1 .SEE PR.PRC
013 PUSHJ P,PRINTA ;CALL PRINTA TO EXPLODEC THE ARGUMENT
014 020 054 MOVE TT,SIXMK2
015 049 033 JRST UNBIND
016
017 SIXMK1: CAIGE A,140 ;THIS SAYS CONVERT LOWER CASE TO UPPER
018 TRC A,40 ;CONVERT CHAR TO SIXBIT
019 TLNE AR1,770000
020 .UDT4: IDPB A,AR1 ;MAYBE SAVE IT, UNLESS ALREADY HAVE SIX
021 POPJ P,
022
023 ;;; TAKE SIXBIT IN TT, RETURN AN ATOMIC SYMBOL IN A.
024 ;;; EMBEDDED BLANKS COUNT, BUT TRALING ONES DON'T.
025 ;;; A ZERO WORD BECOMES THE ATOM "*". SAVES F.
026
027 021 012 SIXATM: SETOM LPNF
028 022 016 MOVE C,PNBP
029 MOVSI T,(ASCII \*\)
030 022 019 MOVEM T,PNBUF
031 022 019 SETZM PNBUF+1
032 106 004 SIXAT1: JUMPE TT,RINTERN ;RINTERN SAVES F
033 131 052 SETZ T,
034 LSHC T,6
035 ADDI T,40 ;CONVERT SIXBIT TO ASCII
036 035 006 IDPB T,C ;STICK CHARACTERS IN PNBUF
037 052 032 JRST SIXAT1
038
039 ;;; A STRING IS IN PNBUF, TERMINATED BY A NULL.
040 ;;; LOCATE ITS END, AND CALL RINTERN TO MAKE AN ATOM.
041
042 022 016 PNBFAT: MOVE T,PNBP
043 035 006 PNBFA1: MOVE C,T
044 ILDB TT,T
045 052 043 JUMPN TT,PNBFA1
046 021 012 SETOM LPNF
047 106 004 JRST RINTERN
048
049 ;;; TAKE AN S-EXPRESSION IN A, AND EXPLODEC IT INTO PNBUF.
050 ;;; AR2A WILL CONTAIN THE COUNT OF UNUSED CHARACTER POSITIONS IN PNBUF.
051 ;;; PRESERVES ITS ARGUMENT.
052
053 PNBFMK: PUSH P,A
VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 52.1
054 059 036 PUSH P,CPOPAJ
055 022 019 SETZM PNBUF
056 022 019 MOVE T,[PNBUF,,PNBUF+1]
057 022 019 BLT T,PNBUF+LPNBUF-1
058 022 016 MOVE AR1,PNBP
059 022 013 MOVEI AR2A,LPNBUF*BYTSWD
060 052 063 HRROI R,PNBFM6 .SEE PR.PRC
061 209 011 JRST PRINTA
062
063 059 031 PNBFM6: JUMPLE AR2A,CPOPJ ;GIVE UP IF NO MORE ROOM IN PNBUF
064 IDPB A,AR1 ;ELSE STICK CHARACTER IN
065 059 031 SOJA AR2A,CPOPJ
VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 53
001
002 005 005 IFN D10,[
003 ;;; CONVERT A PPN IN TT TO AN "ATOM", I.E. AN S-EXPR OF APPROPRIATE FORM. SAVES F.
004
005 PPNATM:
006 002 031 IFN CMU,[
007 HLRZ T,(FXP)
008 CAIG T,10 ;PPN'S WITH PROJECT BETWEEN 1 AND 10
009 053 016 JRST PPNAT2 ; MUST BE EXPRESSED IN DEC FORM
010 022 019 MOVE T,[TT,,PNBUF]
011 022 019 SETZM PNBUF+1 ;NEED THIS BECAUSE OF CMU BUG
012 DECCMU T, ;TRY CONVERTING PPN TO CMU STRING
013 053 016 JRST PPNAT2 ;ON FAILURE, JUST REVERT TO DEC FORMAT
014 POPI FXP,1 ;ON SUCCESS, FLUSH WORD FROM PDL
015 052 042 JRST PNBFAT ; AND CONS UP ATOM FROM STRING
016 PPNAT2:
017 ] ;END OF IFN CMU
018 PUSHN P,1
019 PUSH FXP,TT
020 HLRZS TT
021 053 027 PUSHJ P,PPNAT4 ;CONVERT PROJECT
022 POP FXP,TT
023 TLZ TT,-1
024 053 027 PUSHJ P,PPNAT4 ;CONVERT PROGRAMMER
025 059 035 JRST POPAJ
026
027 PPNAT4:
028 002 031 IFN TOPS10+CMU,[
029 CAIN TT,-1 ;777777 => OMITTED HALF OF PPN
030 SKIPA A,[Q.] ;REPLACE IT WITH *
031 074 007 JSP T,FXCONS ;OTHERWISE USE A FIXNUM
032 MOVE B,-1(P)
033 073 010 PUSHJ P,CONS
034 MOVEM A,-1(P)
035 POPJ P,
036 ] ;END OF IFN TOPS10+CMU
037 002 029 IFN SAIL,[
038 CAIN TT,-1 ;777777 => OMITTED HALF OF PPN
039 053 047 JRST PPNAT9 ;REPLACE IT WITH *
040 053 047 JUMPE TT,PPNAT9 ;? MIGHT AS WELL TREAT 0 AS OMITTED
041 PPNAT6: TLNE TT,770000 ;LEFT JUSTIFY THE SIXBIT CHARACTERS
042 053 048 JRST PPNAT3 ;WHEN DONE, CREATE AN ATOM AND CONS ONTO LIST
043 LSH TT,6
044 053 041 JRST PPNAT6
045 ] ;END OF IFN SAIL
046
047 SA$ PPNAT9: SKIPA A,[Q.]
048 PPNAT3:
049 052 027 20% PUSHJ P,SIXATM
050 052 042 20$ PUSHJ P,PNBFAT
051 PPNAT5: MOVE B,-1(P)
052 073 010 PUSHJ P,CONS
053 MOVEM A,-1(P)
VARIOUS ODDBALL CONSERS LISP.393[MAC,LSP] 01/17/78 Page 53.1
054 POPJ P,
055 ] ;END OF IFN D10
CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 54
001
002 SUBTTL CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES
003
004 CATPUS: PUSH P,B
005 020 041 CATPS1: MOVEM A,CATID
006 057 038 JSP T,ERSTP
007 020 029 MOVEM P,CATRTN
008 209 011 JRST (TT)
009
010 020 046 THROW5: SKIPE D,UIRTN ;IF NO USER INTERRUPT FRAME STACKED,
011 181 046 CAIG D,(TT) ; OR IF IT IS BELOW THE CATCH FRAME,
012 054 050 JRST THROW3 ; THEN JUST EXIT THE CATCH FRAME
013 058 003 JSP TT,UIBRK ;OTHERWISE BREAK OUT OF THE INTERRUPT
014 020 029 THROW1: SKIPN TT,CATRTN ;SKIP IF CATCH FRAME BELOW US
015 054 027 JRST THROW4
016 054 010 JUMPE B,THROW5
017 THROW6: SKIPE T,(TT) ;(CATCH FOO NIL) = (CATCH FOO)
018 CAIN B,(T)
019 054 010 JRST THROW5 ;CATCH ID MATCHES THROW ID
020 020 028 MOVE TT,<-LEP1+1>+<CATRTN-ERRTN>(TT) ;GO BACK ONE CATCH
021 054 017 JUMPN TT,THROW6 ;FALL THROUGH IF NO MORE
022 THROW7: EXCH A,B
023 %UGT EMS29
024 EXCH A,B
025 054 014 JRST THROW1
026
027 054 022 THROW4: JUMPN B,THROW7 ;NO CATCH FRAME -- GIVE UGT EROR
028 040 025 JRST LSPRET ;IF NO THROW TAG, THROW TO TOP LEVEL
029
030 054 014 JRST THROW1 ;COMPILED THROWS COME HERE
031 020 028 ERUNDO: SKIPN ERRTN ;COMPILED ERR, AND NORMAL ERRSET EXIT COMES HERE
032 040 025 JRST LSPRET ;RETURN TO TOPLEVEL
033 ERR0:
034 021 055 IFN USELESS, SETZM TYOSW
035 057 046 JUMPN A,ERUN0 ;ELSE, BREAK UP AN ERRSET
036 SKIPE V.RSET
037 SKIPN VERRSET ;ERRSET BEING BROKEN BY AN ERROR
038 057 046 JRST ERUN0
039 PUSH P,A
040 Q% MOVEI A,ERSTBK
041 181 046 Q$ MOVEI D,1001 ;ERRSET USER INTERRUPT
042 196 007 PUSHJ P,UINT
043 POP P,A
044 057 046 JRST ERUN0
045
046 020 029 SKIPA TT,CATRTN ;PHOOEY, COMPILED CODE COMES HERE WHEN A
047 020 028 GOBRK: MOVE TT,ERRTN ;GO OR RETURN OCCURS WITHIN AN ERRSET OR CATCH
048 JUMPE TT,ER4
049 057 043 EXCH T,-LERSTP(TT)
050 THROW3: MOVE P,TT
051 057 053 JRST ERR1
052
053
CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 54.1
054 048 005 IOGBND: JSP T,SPECBIND ;BIND ALL I/O CONTROL VARIABLES TO NIL:
055 TTYOFF ; ↑W
056 TAPRED ; ↑Q
057 TAPWRT ; ↑R
058 Q% LPTON ; ↑B
059 002 039 IFN MOBIOF, DISPON ; ↑F
060 061 004 EPOPJ: POPJ P, .SEE $ERRFRAME
CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 55
001
002 ;;; MOVEI D,LOOP ;ROUTINE TO LOOP
003 ;;; PUSHJ P,BRGEN
004 ;;; GENERATES A BREAK LOOP SURROUNDED BY A CATCH AND AN
005 ;;; ERRSET. ERRORS CAUSE THE LOOP TO BE RE-ENTERED.
006 ;;; BRGEN RETURNS WHEN THE LOOP ROUTINE PERFORMS A
007 ;;; THROW TO THE TAG BREAK.
008 174 030 .SEE BREAK
009 103 004 .SEE $BREAK
010
011 BRGEN: MOVEI A,QBREAK ;CATCH ID = BREAK
012 054 005 JSP TT,CATPS1 ;SET UP CATCH FRAME
013 181 046 PUSH P,D
014 PUSH P,. ;RETURN POINT FOR ERROR
015 057 038 JSP T,ERSTP ;SET UP ERRSET FRAME
016 020 033 SETOM ERRSW
017 020 028 MOVEM P,ERRTN
018 057 043 JRST @-LERSTP-1(P) ;CALL RANDOM ROUTINE
019
020 ;;; BREAK LOOP USED BY *BREAK
021
022 BRLP1: PUSH P,FLP
023 PUSH P,FXP
024 PUSH P,SP
025 043 016 PUSHJ P,TLEVAL ;EVALUATE FORM READ
026 MOVEM A,V. ;STICK VALUE IN *
027 044 038 PUSHJ P,TLPRINT ;PRINT VALUE
028 HRRZ TT,-2(P)
029 181 046 HRRZ D,-1(P)
030 071 024 HRRZ R,(P)
031 POPI P,3
032 043 037 PUSHJ P,PDLCHK ;CHECK PDL LEVELS
033 041 028 JRST TLTERPRI ;TERPRI IF APPROPRIATE
034
035 055 035 BRLP: PUSH P,BRLP ;***** BASIC BREAK LOOP *****
036 SKIPE A,BLF ;IF USER SUPPLIED A BREAK LOOP FORM,
037 152 043 JRST EVAL ; EVALUATE IT (RETURNS TO BRLP)
038 042 016 PUSHJ P,TLREAD ;OTHERWISE READ A FORM
039 SKIPE VDOLLRP ;IF THE FORM IS EQ TO THE
040 CAME A,VDOLLRP ; NON-NIL VALUE OF THE VARIABLE }P,
041 055 046 JRST BRLP4 ; THEN THAT MEANS RETURN NIL
042 MOVEI A,NIL
043 BRLP2: MOVEI B,QBREAK
044 054 014 JRST THROW1 ;ESCAPE FROM BRGEN LOOP
045
046 BRLP4: HLRZ B,(A) ;(RETURN <FOO>) MEANS RETURN THE
047 CAIE B,QRETURN ; VALUE OF FOO
048 055 022 JRST BRLP1 ;OTHERWISE EVAL AND PRINT THE FORM
049 070 015 JSP T,%CADR
050 152 043 BRLP3: PUSHJ P,EVAL
051 055 043 JRST BRLP2
CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 56
001
002 ;;; JSP T,.STORE ;USED BY COMPILED CODE
003 ;;; ON CALLING .STORE WE MUST HAVE JUST COMPLETED AN "INTERPRETED"
004 ;;; ARRAY REFERENCE OF SOME KIND, BY PUSHJ'ING INTO THE ARRAY HEADER
005 ;;; AND GOING TO ONE OF THE NDIMX ROUTINES. THIS LEAVES THE SAR
006 ;;; OF THE ARRAY REFERENCED IN LISAR, AND THE INDEX WORD IN R.
007 ;;; A CONTAINS THE VALUE TO STORE INTO THE ARRAY.
008
009 181 046 .STORE: SKIPN D,LISAR
010 209 011 JRST .STOLZ ;ERROR IF NO ARRAY REFERENCED LATELY
011 181 046 HLL D,ASAR(D)
012 181 046 TLNN D,AS.SX ;WAS IT AN S-EXPRESSION ARRAY?
013 056 022 JRST .STOR2
014 071 024 .STOR0: MOVEI TT,(R) ;YEP, STORE A HALF-WORD QUANTITY
015 056 019 JUMPL R,.STOR1
016 181 046 HRLM A,@TTSAR(D)
017 209 011 JRST (T)
018
019 181 046 .STOR1: HRRM A,@TTSAR(D)
020 209 011 JRST (T)
021
022 181 046 .STOR2: TLNN D,AS.FX+AS.FL ;SKIP IF FIXNUM OR FLONUM
023 056 034 IFN DBFLAG+CXFLAG, JRST .STOR4
024 .ELSE .VALUE
025 MOVEI F,(T)
026 181 046 TLNN D,AS.FX
027 065 026 JSP T,FLNV1X ;GET FLONUM QUANTITY, WITH SKIP RETURN
028 065 007 JSP T,FXNV1 ;OR MAYBE GET FIXNUM QUANTITY
029 071 024 EXCH TT,R
030 071 024 MOVEM R,@TTSAR(D) ;STORE QUANTITY INTO ARRAY
031 209 011 JRST (F)
032
033 002 069 IFN DBFLAG+CXFLAG,[
034 181 046 .STOR4: TLNN D,AS.DB+AS.CX ;SKIP IF DOUBLE OR COMPLEX
035 209 011 IFN DXFLAG, JRST .STOR6
036 .ELSE .VALUE
037 MOVEI F,(T)
038 181 046 DB$ CX$ TLNN D,AS.DB
039 065 045 DB$ CX$ JSP T,CXNV1X ;GET COMPLEX QUANTITY, WITH SKIP RETURN
040 065 036 DB$ JSP T,DBNV1 ;OR MAYBE GET DOUBLE QUANTITY
041 065 048 DB% JSP T,CXNV1
042 MOVE T,LISAR
043 071 024 EXCH TT,R
044 071 024 MOVEM R,@TTSAR(T) ;STORE QUANTITY INTO ARRAY
045 ADDI TT,1
046 181 046 MOVEM D,@TTSAR(T)
047 209 011 JRST (F)
048 ] ;END OF IFN DBFLAG+CXFLAG
049
050 005 046 IFN DXFLAG,[
051 181 046 .STOR4: TLNN D,AS.DX ;SKIP IF DUPLEX
052 .VALUE ;IF NOT THAT, THEN ERROR (UNKNOWN ARRAY TYPE)
053 PUSH P,F
CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 56.1
054 071 024 PUSH FXP,R
055 065 058 JSP T,DXNV1
056 MOVE T,LISAR
057 EXCH TT,(FXP)
058 071 024 KA MOVEM R,@TTSAR(T) ;STORE QUANTITY INTO ARRAY
059 KA ADDI TT,1
060 KA MOVEM F,@TTSAR(T)
061 KA ADDI TT,1
062 071 024 KIKL DMOVEM R,@TTSAR(T)
063 KIKL ADDI TT,2
064 POP FXP,@TTSAR(T)
065 ADDI TT,1
066 181 046 MOVEM D,@TTSAR(T)
067 POPJ P,
068 ] ;END OF IFN DXFLAG
CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 57
001
002 ;;; JSP T,.SET ;USED BY COMPILED CODE
003 ;;; ATOM TO SET IN AR1, AND VALUE TO SET TO IN A.
004 ;;; THE VALUE MUST NOT BE A PDL QUANTITY.
005
006 .SET: EXCH A,AR1
007 .SET1: PUSH P,A
008 050 010 PUSHJ P,BIND ;BIND TAKES SYMBOL IN A, VALUE IN AR1
009 POP P,A ;THIS CROCKISH IMPLEEMNTATION
010 EXCH A,AR1 ; PERFORMS A SET BY DOING A SPECBIND,
011 014 013 JRST SETXIT ; THEN DISCARDING THE BINDING FROM SP
012
013
014 ;;; JSP TT,FWNACK ;OR LWNACK
015 ;;; FAXXXX,,QFOO ;OR LAXXXX,,QFOO
016 ;;; CHECKS FOR AN FSUBR (LSUBR) THAT THE RIGHT NUMBER OF ARGUMENTS
017 ;;; WERE PROVIDED, AND GENERATES AN APPROPRIATE WNA ERROR IF NOT.
018 ;;; THE FAXXXX (LAXXXX) HAS THE LOW BIT 0 FOR LSUBR, 1 FOR FSUBR.
019 ;;; BIT 2←N IS SET IFF GETTING EXACTLY N ARGUMENTS IS ACCEPTABLE.
020
021 131 052 FWNACK: SETZ T, ;COUNT UP ACTUAL NUMBER OF ARGS
022 181 046 MOVEI D,(A) ;LEAVES NEGATIVE OF NUMBER OF ARGS IN T,
023 057 027 FWNAC1: JUMPE D,LWNACK ; SO CAN FALL INTO LSUBR CHECKER
024 181 046 HRRZ D,(D)
025 057 023 SOJA T,FWNAC1
026
027 181 046 LWNACK: MOVE D,(TT) ;GET WORD OF BITS
028 181 046 ASH D,(T)
029 181 046 TLNE D,2 ;SKIP UNLESS WNA
030 209 011 JRST 1(TT)
031 209 011 JRST WNAL0 ;GO PRODUCE A WRNG-NO-ARGS ERROR
032
033
034 ;;; PUSH CRUFT FOR AN ERRSET/CATCH/READEOF FRAME
035 ;;; BEWARE! THE COMPILER DEPENDS ON THE LENGTH OF THE
036 ;;; ERRSET FRAME BEING A CONSTANT.
037
038 ERSTP: PUSH P,PA3 ;"ERRSET" PUSH
039 PUSH P,SP ;MUST SAVE TT - SEE $TYI
040 PUSH P,FLP
041 PUSH P,FXP
042 020 028 REPEAT LEP1, PUSH P,ERRTN+.RPCNT
043 057 038 LERSTP==.-ERSTP ;LENGTH OF ERRSET PUSH
044 209 011 JRST (T)
045
046 020 028 ERUN0: HRRZ TT,ERRTN ;GENERAL BREAK OUT OF AN ERRSET
047 020 046 SKIPE D,UIRTN
048 181 046 CAIL TT,(D)
049 057 052 JRST ERR1A
050 058 003 JSP TT,UIBRK ;MAYBE BREAK UP A USER INTERRUPT FIRST
051 057 046 JRST ERUN0
052 020 028 ERR1A: MOVE P,ERRTN
053 024 067 ERR1: SETZM PANICP
CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 57.1
054 020 042 MOVSI D,-LEP1+1(P)
055 020 028 HRRI D,ERRTN
056 020 028 BLT D,ERRTN+LEP1-1
057 057 064 SUB P,EPC1
058 POP P,FXP
059 POP P,FLP
060 POP P,TT
061 POP P,PA3
062 049 003 JRST UBD0 ;RESTORE CONDITIONS AND PROCEED
063
064 020 042 EPC1: LEP1,,LEP1
065
CATCH, THROW, ERRSET, .SET, AND BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 58
001
002
003 UIBRK:
004 181 046 Q% HRRM TT,-2(D) ;BREAK OUT OF A USER INTERRUPT
005 181 046 Q$ HRRM TT,-1(D)
006 181 046 HRRO FXP,1(D) ;JUST SET LEFT HALF OF PDL POINTERS
007 181 046 HLRO FLP,1(D) ; TO -1 FOR BIBOP, AND LET PDLOV
008 197 038 Q% HRROI P,-LUINF-1(D) ; DO THE REST OF THE WORK!
009 199 054 Q$ HRROI P,-UIFRM(D)
010 120 002 IFE QIO,[ .SEE FRETURN
011 022 070 MOVEM F,-LSWS(FXP) ;LET F BE SECURE OVER THE RESTORATION
012 022 070 MOVEM T,-LSWS-4(FXP) ;T TOO
013 035 006 MOVEM C,-3(P) ;C TOO
014 MOVEM B,-4(P) ;B TOO
015 197 038 MOVEM A,LUINF(P) ;A TOO
016 ] ;END OF IFE QIO
017 002 048 IFN QIO,[
018 199 048 MOVEM F,UISAVT-T+F(FXP) ;LET F BE SAFE OVER RESTORATION
019 199 048 MOVEM T,UISAVT(FXP) ;T TOO
020 199 055 MOVEM C,UISAVA-A+C(P) ;C TOO
021 199 055 MOVEM B,UISAVA-A+B(P) ;B TOO
022 199 055 MOVEM A,UISAVA(P) ;A TOO
023 ] ;END OF IFN QIO
024 198 009 JRST UINT0X
VARIOUS COMMON EXITS LISP.393[MAC,LSP] 01/17/78 Page 59
001
002 SUBTTL VARIOUS COMMON EXITS
003
004 CIN0: IN0 ;SURPRISE!
005
006 ;;; THESE ROUTINES ARE USEFUL FOR CONSING UP LISTS OF NUMBERS
007 ;;; (AS STATUS FUNCTIONS OFTEN DO, FOR INSTANCE).
008 ;;; A CALL TO CONS1FX WILL TAKE A NUMBER IN TT AND MAKE A SINGLETON
009 ;;; LIST OF IT. SUCCESSIVE CALLS TO CONSFX WILL THEN TACK NEW NUMBERS
010 ;;; ONTO THE FRONT OF THE LIST. CONS1PFX AND CONSPFX ARE SIMILAR,
011 ;;; BUT POP THE NUMBER FROM FXP. IN THIS WAY ONE CAN PRODUCE NUMBERS
012 ;;; IN FORWARDS ORDER, PUSHING THEM ON FXP, THEN USE THESE ROUTINES
013 ;;; TO CONS THEM UP IN REVERSE ORDER, PRODUCING A FORWARDS LIST OF THEM.
014
015 CONS1PFX: TDZA B,B
016 CONS1FX: TDZA B,B
017 CONSPFX: POP FXP,TT
018 074 007 CONSFX: JSP T,FXCONS
019 073 010 CONSIT: PUSHJ P,CONS
020 BAPOPJ: MOVEI B,(A)
021 POPJ P,
022
023 ;;; OTHER COMMON EXITS
024
025 ZPOPJ: TDZA TT,TT ;ZERO TT, THEN POPJ
026 065 007 POPNVJ: JSP T,FXNV1 ;FXNV1, THEN POPJ
027 059 027 CCPOPJ: POPJ P,CCPOPJ ;NOT CPOPJ! WILL SCREW BAKTRACE
028
029 059 004 0POPJ: SKIPA A,CIN0 ;PUT A LISP FIXNUM 0 IN A AND POPJ
030 POP2J: POPI P,2 ;POP 2 PDL SLOTS AND POPJ
031 059 031 CPOPJ: POPJ P,CPOPJ .SEE BAKTRACE ;SACRED TO BAKTRACE
032
033 POPAJ1: AOSA -1(P) ;POP INTO A, THEN SKIP RETURN
034 S1PAJ: POPI P,1 ;POP 1 PDL SLOT, POP INTO A, AND POPJ
035 POPAJ: POP P,A ;POP A, THEN POPJ
036 059 035 CPOPAJ: POPJ P,POPAJ
037
038 POP1J1: AOSA -1(P) ;POP 1 PDL SLOT, THEN SKIP RETURN
039 POPJ1: AOSA (P) ;SKIPPING POPJ RETURN
040 POP1J: POPI P,1 ;POP 1 PDL SLOT AND POPJ
041 059 040 CPOP1J: POPJ P,POP1J
042
043 064 014 M1TTPJ: SKIPA TT,XC-1 ;-1 IN TT, THEN POPJ
044 035 006 POPCJ: POP P,C ;POP C, THEN POPJ
045 059 044 CPOPCJ: POPJ P,POPCJ
046
047 UNLKFALSE: TDZA A,A ;UNLOCK INTERRUPTS, RETURNING FALSE (NIL)
048 UNLKTRUE: MOVEI A,TRUTH ;UNLOCK INTERRUPTS, RETURNING TRUTH (T)
049 UNLKPOPJ
050
051 PX1J: POPI FXP,1 ;FLUSH 1 FXP SLOT, THEN POPJ P,
052 059 054 CPXDFLJ: POPJ P,PXDFLJ
053
VARIOUS COMMON EXITS LISP.393[MAC,LSP] 01/17/78 Page 59.1
054 181 046 PXDFLJ: HLLZ D,(P) ;POP FXP INTO D, THEN POPJ P,
055 059 057 JRST 2,POPXDJ(D) ; AND RESTORE FLAGS FROM THE P SLOT
056
057 181 046 POPXDJ: POP FXP,D ;POP FXP SLOT INTO D, THEN POPJ P,
058 059 057 CPXDJ: POPJ P,POPXDJ
VARIOUS COMMON SAVE AND RESTORE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 60
001
002 SUBTTL VARIOUS COMMON SAVE AND RESTORE ROUTINES
003
004 SAV5: PUSH P,A
005 SAV5M1: PUSH P,B
006 035 006 SAV5M2: PUSH P,C
007 SAV5M3: PUSH P,AR1
008 PUSH P,AR2A
009 CPOPXJ: POPJ FXP,
010
011 SAV3: PUSH P,A
012 PUSH P,B
013 035 006 PUSH P,C
014 POPJ FXP,
015
016 035 006 RST3: POP P,C
017 RST2: POP P,B
018 059 035 JRST POPAJ
019
020 059 027 R5M1PJ: PUSH FXP,CCPOPJ
021 RST5M1: POP P,AR2A
022 POP P,AR1
023 035 006 POP P,C
024 POP P,B
025 060 020 CR5M1PJ: POPJ FXP,R5M1PJ
026
027 RST5M2: POP P,AR2A
028 POP P,AR1
029 035 006 POP P,C
030 POPJ FXP,
031
032 RST5M3: POP P,AR2A
033 POP P,AR1
034 POPJ FXP,
035
036 SAVX5: PUSH FXP,T
037 060 041 PUSHJ P,SAVX3
038 PUSH FXP,F
039 POPJ P,
040
041 SAVX3: PUSH FXP,TT
042 181 046 PUSH FXP,D
043 071 024 PUSH FXP,R
044 POPJ P,
045
046 RSTX5: POP FXP,F
047 071 024 POP FXP,R
048 181 046 POP FXP,D
049 PXTTTJ: POP FXP,TT
050 POPXTJ: POP FXP,T
051 POPJ P,
052
053 071 024 RSTX3: POP FXP,R
VARIOUS COMMON SAVE AND RESTORE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 60.1
054 181 046 RSTX2: POP FXP,D
055 RSTX1: POP FXP,TT
056 059 026 CPOPNVJ: POPJ P,POPNVJ
VARIOUS KINDS OF FRAME MARKERS LISP.393[MAC,LSP] 01/17/78 Page 61
001
002 SUBTTL VARIOUS KINDS OF FRAME MARKERS
003
004 054 060 $ERRFRAME=525252,,EPOPJ ;ERROR FRAME
005 059 030 $EVALFRAME=525252,,POP2J ;EVAL FRAME
006 ;; $APPLYFRAME=525252,,AFPOPJ ;APPLY FRAME DEFINED BELOW
007 059 036 $UIFRAME=525252,,CPOPAJ ;USER INTERRUPT FRAME
008
009 ;;; FORMAT OF EVALFRAME:
010 ;;; <FLP>,,<FXP>
011 ;;; <SP>,,<FORM>
012 ;;; $EVALFRAME
013
014 ;;; FORMAT OF APPLYFRAME:
015 ;;; -- ARGS --
016 ;;; <FLP>,,<FXP>
017 ;;; <SP>,,<FUNCTION>
018 ;;; $APPLYFRAME
019 ;;; WHERE -- ARGS -- MAY BE ONE OF THREE THINGS, DEPENDING
020 ;;; ON ITS LEFT HALF:
021 ;;; LH=0 RH=LIST OF ARGS
022 ;;; LH<0 LH,,RH=AOBJN POINTER TO ARGS VECTOR (E.G. FOR LSUBR)
023 ;;; LH>0 RH=LAST ARG; OTHER ARGS ARE BELOW THIS ON THE
024 ;;; STACK. IN THIS CASE THE APPLYFRAME MAY BE MORE
025 ;;; THAN FOUR WORDS LONG.
026 ;;; EXAMPLE: MOVEI A,QFOO
027 ;;; MOVEI B,QBAR
028 ;;; CALL 2,QUUX
029 ;;; CAUSES THIS APPLYFRAME TO APPEAR ON THE STACK:
030 ;;; 0,,QFOO
031 ;;; 2,,QBAR
032 ;;; <FLP>,,<FXP>
033 ;;; <SP>,,QUUX
034 ;;; $APPLYFRAME
035
036 AFPOPJ: HLRE T,-2(P) ;APPLYFRAME POPJ
037 SKIPG T ;FIGURE OUT LENGTH OF
038 MOVEI T,1 ; APPLY FRAME
039 ADDI T,2
040 HRLI T,(T)
041 SUB P,T ;POP CRUFT FROM PDL
042 POPJ P, ;RETURN
043
044 061 036 $APPLYFRAME=525252,,AFPOPJ ;APPLY FRAME
045
NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 62
001
002 SUBTTL NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES
003
004 002 069 IFN BIGNUM+DBFLAG+CXFLAG,[
005 FLTSK1: %WTA NMV5 ;UNACCEPTABLE NUMERIC VALUE
006 062 010 IFE NARITH, JRST 2,@[FLTSKP] ;CLEAR PC FLAGS
007 ] ;END OF IFN BIGNUM+DBFLAG+CXFLAG
008 FLTSK2: %WTA NMV3 ;NON-NUMERIC VALUE
009 062 010 IFE NARITH, JRST 2,@[FLTSKP] ;CLEAR PC FLAGS
010 FLTSKP: MOVEI TT,(A) ;"FLOAT SKIP" ROUTINE
011 005 042 LSH TT,-SEGLOG ; SKIPS 0 FOR FIXNUMS, 1 FOR FLONUMS (OR DOUBLES)
012 036 033 HRRZ TT,ST(TT) ;LEAVES NUMERIC VALUE IN TT
013 062 016 IFE NARITH, 2DIF JRST @(TT),FLTSTB,QLIST
014 062 016 IFN NARITH, 2DIF [JRST 2,@(TT)]FLTSTB,QLIST ;DISPATCH AND CLEAR PC FLAGS
015
016 062 008 FLTSTB: FLTSK2 ;LIST ;ERROR
017 062 031 FLTSFX ;FIXNUM ;SKIPS 0
018 062 035 FLTSFL ;FLONUM ;SKIPS 1
019 062 035 DB$ FLTSFL ;DOUBLE ;SKIPS 1
020 062 005 CX$ FLTSK1 ;COMPLEX;ERROR
021 062 005 DX$ FLTSK1 ;DUPLEX ;ERROR
022 062 005 BG$ FLTSK1 ;BIGNUM ;ERROR
023 062 008 FLTSK2 ;SYMBOL ;ERROR
024 062 008 REPEAT HNKLOG, FLTSK2 ;HUNKS ;ERROR
025 062 008 FLTSK2 ;RANDOM ;ERROR
026 062 008 FLTSK2 ;ARRAY ;ERROR
027 062 016 IFN .-FLTSTB-NTYPES, WARN [WRONG LENGTH TABLE]
028
029 002 070 IFN BIGNUM*<1-NARITH>, NVSKBG:
030 002 070 IFN BIGNUM*NARITH, NMSKBG:
031 FLTSFX: MOVE TT,(A)
032 209 011 JRST (T)
033
034 002 070 IFN BIGNUM*<1-NARITH>, NVSKFX:
035 FLTSFL: MOVE TT,(A)
036 209 011 JRST 1(T)
037
038
039 002 070 IFN BIGNUM*<1-NARITH>,[
040 NVSKP2: %WTA NMV3 ;NON-NUMERIC VALUE
041 NVSKIP: MOVEI TT,(A) ;"NUMERIC VALUE SKIP"
042 005 042 LSH TT,-SEGLOG ;SKIPS: 0 = BIGNUM, 1 = FIXNUM, 2 = FLONUM, ELSE ERROR
043 036 033 HRRZ TT,ST(TT) ;LEAVES NUMERIC VALUE IN TT
044 036 038 2DIF JRST @(TT),NVSKTB,QLIST .SEE STDISP
045
046 062 040 NVSKTB: NVSKP2 ;LIST ;ERROR
047 062 034 NVSKFX ;FIXNUM ;SKIPS 1
048 062 059 NVSKFL ;FLONUM ;SKIPS 2
049 062 040 DB$ NVSKP2 ;DOUBLE
050 062 040 CX$ NVSKP2 ;COMPLEX
051 062 040 DX$ NVSKP2 ;DUPLEX
052 062 029 BG$ NVSKBG ;BIGNUM ;SKIPS 0, LEAVES BIGNUM HEADER IN TT
053 062 040 NVSKP2 ;SYMBOL ;ERROR
NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 62.1
054 062 040 REPEAT HNKLOG, NVSKP2 ;HUNKS ;ERROR
055 062 040 NVSKP2 ;RANDOM ;ERROR
056 062 040 NVSKP2 ;ARRAY ;ERROR
057 062 046 IFN .-NVSKTB-NTYPES, WARN [WRONG LENGTH TABLE]
058
059 NVSKFL: MOVE TT,(A)
060 209 011 JRST 2(T)
061 ] ;END OF IFN BIGNUM*<1-NARITH>
NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 63
001
002 002 070 IFN NARITH,[
003
004 ;;; NUMERIC SKIP ROUTINE
005 ;;; JSP T,NMSKIP
006 ;;; BG$ ... ;HERE FOR BIGNUMS; LEAVES HEADER IN TT
007 ;;; DX$ ... ;HERE FOR DUPLEX
008 ;;; CX$ ... ;HERE FOR COMPLEX
009 ;;; DB$ ... ;HERE FOR DOUBLE; LEAVES FIRST WORD IN TT
010 ;;; ... ;HERE FOR FLONUM; LEAVES VALUE IN TT
011 ;;; ... ;HERE FOR FIXNUM; LEAVES VALUE IN TT
012 ;;; ALSO CLEARS THE PC FLAGS
013
014 NMSKP2: %WTA NMV3 ;NON-NUMERIC VALUE
015 NMSKIP: MOVEI TT,(A)
016 005 042 LSH TT,-SEGLOG
017 036 033 HRRZ TT,ST(TT)
018 063 021 2DIF [JRST 2,@(TT)]NMSKTB,QLIST
019
020 ;PC FLAGS IN THIS TABLE MUST BE ZERO
021 063 014 NMSKTB: NMSKP2 ;LIST
022 063 034 NMSKFX ;FIXNUM
023 063 037 NMSKFL ;FLONUM
024 063 040 DB$ NMSKDB ;DOUBLE
025 063 043 CX$ NMSKCX ;COMPLEX
026 DX$ NMSKDX ;DUPLEX
027 062 030 BG$ NMSKBG ;BIGNUM
028 062 040 NVSKP2 ;SYMBOL
029 062 040 REPEAT HNKLOG, NVSKP2 ;HUNKS
030 062 040 NVSKP2 ;RANDOM
031 062 040 NVSKP2 ;ARRAY
032 062 046 IFN .-NVSKTB-NTYPES, WARN [WRONG LENGTH TABLE]
033
034 NMSKFX: MOVE TT,(A)
035 002 068 JRST BIGNUM+DXFLAG+CXFLAG+DBFLAG+1(T)
036
037 NMSKFL: MOVE TT,(A)
038 002 068 JRST BIGNUM+DXFLAG+CXFLAG+DBFLAG(T)
039
040 DB$ NMSKDB: MOVE TT,(A)
041 002 069 DB$ JRST BIGNUM+DXFLAG+CXFLAG(T)
042
043 005 046 CX$ NMSKCX: JRST BIGNUM+DXFLAG(T)
044
045 002 041 DX$ NMSKDB: JRST BIGNUM(T)
046
047 ] ;END OF IFN NARITH
NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 64
001
002 LR70==:20 ;LAP AND FASLAP HAVE THIS QUANTITY BUILT IN
003
004 075 045 CDUPL1: DUPL1 ;FOR (% 0 0 DUPL1)
005 075 025 CCMPL1: CMPL1 ;FOR (% 0 0 CMPL1)
006 075 003 CDBL1: DBL1 ;FOR (% 0 0 DBL1)
007 074 006 CFIX1: FIX1 ;FOR (% 0 0 FIX1)
008 074 028 CFLOAT1: FLOAT1 ;FOR (% 0 0 FLOAT1)
009 064 002 R70: REPEAT LR70, .RPCNT,,.RPCNT ;COMMON LAP CONSTANTS ALSO USED BY LISP CODE
010
011 ZZZ==5
012 004 063 IFL ZZZ-NACS, ZZZ==NACS ;NEED AT LEAST <NACS> OF THESE
013 004 063 REPEAT ZZZ, .RPCNT-ZZZ
014 XC:: ;WRITE "XC-N" TO GET THE CONSTANT -N FOR SMALL N
015
016
017 ;;; INTERNAL FLONUM-TO-FIXNUM CONVERSION; DOES NO ERROR CHECKS.
018 ;;; CONVERTS NUMBER IN TT TO BE A FIXNUM, CLOBBERING D.
019 ;;; THE CONVERSION IS A "FLOOR" OR "ENTIER" FUNCTION.
020 ;;; THAT IS, 3.5 => 3, BUT -3.5 => -4.
021
022 IFIX: MULI TT,400 ;EXPONENT IN TT, MANTISSA IN D
023 TSC TT,TT ;THIS HACK GETS MAGNITUDE OF EXPONENT
024 181 046 ASH D,-243(TT) ;SHIFT THE MANTISSA
025 181 046 MOVE TT,D ;RESULT IN TT
026 209 011 JRST (T)
027
028
029 ;;; INTERNAL FIXNUM-TO-FLONUM CONVERSION. SAVES D.
030
031 IFLOAT: TLNE TT,777000 ;FOR POSITIVE INTEGERS 27. BITS OR LESS,
032 064 036 JRST IFLT1 ; CAN JUST USE FSC TO SCALE
033 IFLT5: FSC TT,233 ;FSC NORMALIZES RESULT
034 209 011 JRST (T)
035
036 IFLT1: TLC TT,777000 ;THE SAME HACK WORKS FOR NEGATIVE NUMBERS
037 TLCN TT,777000 ; WITH NO MORE THAN 27. SIGNIFICANT BITS
038 064 033 JRST IFLT5
039 020 063 IFLT2: MOVEM D,IFLT9 ;FOR 28. TO 35. BITS OF SIGNIFICANCE,
040 064 049 JUMPL TT,IFLT3 ; WE CONVERT THE LEFT AND RIGHT HALVES
041 181 046 HLRZ D,TT ; SEPARATELY, AND THEN ADD THEM, TRUNCATING
042 MOVEI TT,(TT)
043 181 046 IFLT4: FSC D,255 ;SCALE RIGHT HALF
044 FSC TT,233 ;SCALE LEFT HALF
045 181 046 FAD TT,D ;ADD TOGETHER
046 020 063 MOVE D,IFLT9 ;RESTORE D
047 209 011 JRST (T)
048
049 181 046 IFLT3: HLRO D,TT ;FOR NEGATIVE NUMBERS, WE MUST
050 HRROI TT,(TT) ; PRODUCE THE CORRECT SIGN
051 064 043 AOJA D,IFLT4
NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 65
001
002 ;;; NUMERIC VALUE ROUTINES. THESE CHECK AN S-EXPRESSION
003 ;;; FOR BEING THE DESIRED NUMERIC TYPE, AND PRODUCE A
004 ;;; WRNG-TYPE-ARG ERROR IF APPROPRIATE. OTHERWISE
005 ;;; THE VALUE OF THE NUMBER IS LIFTED INTO TT (D,R,F).
006
007 COMMENT |FXNV1: FXNV2: FXNV3: FXNV4:|
008
009 ;;; FXNV1 (2,3,4) TAKES S-EXP IN A (B,C,AR1) AND PUTS VALUE IN TT (D,R,F).
010
011 065 012 IRPC AC,,[1234]
012 EFXNV!AC:
013 065 012 IFN AC-A, EXCH A,AC
014 %WTA FXNMER
015 065 012 IFN AC-A, EXCH A,AC
016 065 012 FXNV!AC: MOVEI TT-1+AC,(AC) ;CHECK DATA TYPE
017 065 012 ROT TT-1+AC,-SEGLOG
018 036 033 SKIPL TT-1+AC,ST(TT-1+AC)
019 065 012 TLNN TT-1+AC,FX ;SKIP IFF FIXNUM
020 065 012 JRST EFXNV!AC ;LOSE
021 065 012 MOVE TT-1+AC,(AC) ;GET VALUE IN NUMERIC AC
022 209 011 JRST (T)
023 TERMIN
024
025
026 065 029 FLNV1X: AOJA T,FLNV1 ;FLNV1 WITH SKIP RETURN
027
028 EFLNV1: %WTA FLNMER
029 FLNV1: SKOTT A,FL ;GET FLONUM VALUE IN TT FROM A
030 065 028 JRST EFLNV1
031 MOVE TT,(A)
032 209 011 JRST (T)
033
034 002 068 IFN DBFLAG,[
035 EDBNV1: %WTA DBNMER
036 DBNV1: SKOTT A,DB ;GET DOUBLE VALUE IN (TT,D) FROM A
037 065 035 JRST EDBNV1 ;HIGH ORDER WORD IN TT, LOW ORDER IN D
038 KA MOVE TT,(A)
039 181 046 KA MOVE D,1(A)
040 KIKL DMOVE TT,(A)
041 209 011 JRST (T)
042 ] ;END OF IFN DBFLAG
043
044 002 069 IFN CXFLAG,[
045 065 048 CXNV1X: AOJA T,CXNV1 ;CXNV1 WITH SKIP RETURN
046
047 ECXNV1: %WTA CXNMER
048 CXNV1: SKOTT A,CX ;GET COMPLEX VALUE IN (TT,D) FROM A
049 065 047 JRST ECXNV1 ;REAL PART IN TT, IMAGINARY IN D
050 KA MOVE TT,(A)
051 181 046 KA MOVE D,1(A)
052 KIKL DMOVE TT,(A)
053 209 011 JRST (T)
NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 65.1
054 ] ;END OF IFN CXFLAG
055
056 005 046 IFN DXFLAG,[
057 EDXNV1: %WTA DXNMER
058 DXNV1: SKOTT A,DX ;GET DUPLEX VALUE IN (R,F,TT,D) FROM A
059 065 028 JRST EFLNV1 ;REAL PART IN (R,F), IMAGINARY IN (TT,D)
060 KA REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT(A)
061 071 024 KIKL DMOVE R,2(A)
062 KIKL DMOVE TT,(A)
063 209 011 JRST (T)
064 ] ;END OF IFN DXFLAG
065
066 BAKPRO
067 RSXST: HRRZ TT,VREADTABLE ;READ CHARACTER SYNTAX
068 HRRZ TT,TTSAR(TT) ; TABLE SETUP
069 HRLI TT,((A)) ;USED AS INDIRECT ADDRESS WITH
070 020 049 MOVEM TT,RSXTB ;INDEX FIELD A
071 NOPRO
072 209 011 JRST (T)
SUPPORT FOR LAP/FASLAP CODE LISP.393[MAC,LSP] 01/17/78 Page 66
001
002 SUBTTL SUPPORT FOR LAP/FASLAP CODE
003
004 ;;; USE THE PUSHN MACRO TO PUSH N NIL'S (0'S, 0.0'S) ONTO P (FXP, FLP).
005 ;;; IT WILL GENERATE JSP T,NPUSH-N (0PUSH, 0.0PUSH) AS APPROPRIATE.
006 ;;; COMPILED CODE USES THESE ROUTINES VERY FREQUENTLY.
007
008 064 009 REPEAT NNPUSH, CONC \NNPUSH-.RPCNT,NPUSH,: PUSH P,R70
009 209 011 NPUSH: JRST (T)
010
011 064 009 REPEAT N0PUSH, CONC \N0PUSH-.RPCNT,PUSH,: PUSH FXP,R70
012 209 011 0PUSH: JRST (T)
013
014 064 009 REPEAT N0.0PUSH, CONC \N0.0PUSH-.RPCNT,.PUSH,: PUSH FLP,R70
015 209 011 0.0PUSH: JRST (T)
016
017
018 066 020 CINTREL: INTREL ;RANDOM USEFUL RETURN ADDRESS
019
020 020 032 INTREL: POP FXP,INHIBIT .SEE UNLOCKI ;COME HERE TO PERFORM AN UNLOCKI
021 015 019 CHECKI: SKIPN NOQUIT ;CHECK FOR DELAYED INTRRUPTS
022 015 012 SKIPN INTFLG
023 POPJ P, ;EXIT IF NONE
024 201 002 JRST CKI0 ;ELSE GO PROCESS
025 182 031 .SEE INTXIT
026
027
028 054 004 JRST CATPUS ;COMPILED CODE CALLS CATCH
029 ERSETUP: PUSH P,B ;COMPILED CODE CALLS ERRSET
030 057 038 JSP T,ERSTP
031 020 028 MOVEM P,ERRTN
032 020 033 SETZM ERRSW
033 SKIPE A ;VALUE IN A DESCRIBES WHETHER ERRORS SHOULD PRINT
034 020 033 SETOM ERRSW
035 209 011 JRST (TT)
SUPPORT FOR COMPILED LSUBRS LISP.393[MAC,LSP] 01/17/78 Page 67
001
002 SUBTTL SUPPORT FOR COMPILED LSUBRS
003
004 ;;; ORDINARY TYPE COMPILED LSUBRS BEGIN THEIR CODE WITH
005 ;;; JSP D,.LCALL
006 ;;; NUMERIC TYPE COMPILED LSUBRS BEGIN THEIR CODE WITH
007 ;;; JSP D,.LCALL-N ;N IS A FUNCTION OF THE TYPE
008 ;;; JSP D,.LCALL
009 ;;; THIS ROUTINE TAKES CARE OF BINDING ARGLOC AND ARGNUM FOR THE
010 ;;; BENEFIT OF THE ARG, SETARG, AND LISTIFY FUNCTIONS,
011 ;;; AND TAKE CARE OF FLUSHING THE ARGUMENTS FROM THE STACK.
012
013 ;;; THE ORDER OF THESE ENTRY POINTS IS BUILT INTO THE COMPILER
014 067 055 JRST .LCADX ;SETUP FOR DUPLEX TYPE COMPILED LSUBRS
015 067 050 JRST .LCACX ;SETUP FOR COMPLEX TYPE COMPILED LSUBRS
016 067 045 JRST .LCADB ;SETUP FOR DOUBLE TYPE COMPILED LSUBRS
017 067 042 JRST .LCAFL ;SETUP FOR FLONUM TYPE COMPILED LSUBRS
018 067 039 JRST .LCAFX ;SETUP FOR FIXNUM TYPE COMPILED LSUBRS
019 064 009 .LCALL: PUSH P,R70 ;SETUP FOR REGULAR COMPILED LSUBRS, OR NCALL ENTRY
020 .LCAF5: MOVN TT,T ;NUMBER OF ARGS
021 ADDI T,-1(P) ;ADDR OF BEGINNING OF ARG VECTOR
022 CAIL TT,XHINUM ;XHINUM IS TYPICALLY >777, SO THERE'S LITTLE
023 209 011 JRST LXPRLZ ; CHANCE OF THIS SCREW, BUT BETTER BE SAFE
024 MOVEI A,IN0(TT)
025 MOVEI TT,(T)
026 048 005 JSP T,SPECBIND
027 0 TT,ARGLOC ;ARGLOC HOLDS PDL POSITION FOR VECTOR OF LSUBR ARGS
028 0 A,ARGNUM ;ARGNUM IS NUMBER OF ARGS, AS A LISP FIXNUM
029 181 046 PUSHJ P,(D) ;CALL THE USER FUNCTION, NUMBER OF ARGS IN A
030 181 046 POP P,D
031 SKIPN T,@ARGNUM
032 067 035 JRST .LCAF7 ;MIGHT AS WELL BUM FOR NO ARGUMENTS
033 HRLS T ;GOT TO GET RID OF THE ARGUMENTS
034 SUB P,T
035 049 033 .LCAF7: JUMPE D,UNBIND ;THIS EXIT SIGNALS CALL TO NOTYPE LSUBR, OR NCALL TO NUMERIC
036 181 046 PUSH P,D ;ELSE EXIT THROUGH FIX1 OR EQUIVALENT,
037 049 033 JRST UNBIND ; MEANING REGULAR CALL TO NUMERIC LSUBR
038
039 064 007 .LCAFX: PUSH P,CFIX1 ;PUSH ADDRESS FOR CONVERTINGMACHINE NUMBER TO FIXNUM
040 067 020 AOJA D,.LCAF5 ;INCREMENT D PAST THE CALL TO .LCALL-0 WHICH FOLLOWS
041
042 064 008 .LCAFL: PUSH P,CFLOAT1
043 067 020 AOJA D,.LCAF5
044
045 .LCADB:
046 064 006 DB$ PUSH P,CDBL1
047 067 020 DB$ AOJA D,.LCAF5
048 205 008 DB% LERR [SIXBIT \CALL TO DOUBLE-TYPE USER LSUBR!\]
049
050 .LCACX:
051 064 005 CX$ PUSH P,CCMPL1
052 067 020 CX$ AOJA D,.LCAF5
053 205 008 CX% LERR [SIXBIT \CALL TO COMPLEX-TYPE USER LSUBR!\]
SUPPORT FOR COMPILED LSUBRS LISP.393[MAC,LSP] 01/17/78 Page 67.1
054
055 .LCADX:
056 064 004 DX$ PUSH P,CDUPL1
057 067 020 DX$ AOJA D,.LCAF5
058 205 008 DX% LERR [SIXBIT \CALL TO DUPLEX-TYPE USER LSUBR!\]
VARIOUS LISTING AND DE-LISTING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 68
001
002 ;;; THESE THREE FUNCTIONS MERELY SAVE THE LOSER THE TROUBLE OF TYPING "SETQ ".
003
004 086 005 NORET: PUSHJ P,NOTNOT ;SUBR 1
005 HRRZM A,VNORET
006 POPJ P,
007
008 086 005 .RSET: PUSHJ P,NOTNOT ;SUBR 1
009 MOVEM A,V.RSET
010 POPJ P,
011
012 086 005 NOUUO: PUSHJ P,NOTNOT ;SUBR 1
013 HRRZM A,VNOUUO
014 POPJ P,
015
016
017 SUBTTL VARIOUS LISTING AND DE-LISTING ROUTINES
018
019 059 027 LIST: PUSH FXP,CCPOPJ ;LSUBR
020 LISTX: MOVEI A,NIL ;BASICALLY, THE FUNCTION "LIST"
021 071 024 SKIPN R,T ; CALLED WITH A PUSH FXP,
022 060 009 LISTX3: JUMPE R,CPOPXJ
023 MOVEI B,(A) ;CLOBBERS A,B,T,TT,R
024 POP P,A
025 094 012 JSP T,PDLNMK
026 073 042 JSP T,%CONS
027 068 022 AOJA R,LISTX3
028
029 ;;; INTERNAL LISTING FUNCTION; EVALUATES A LIST OF ARGS,
030 ;;; STACKING THEIR VALUES ON THE PDL
031
032 KLIST: HLRZ B,(A) ;SUPER-HACKISH VERSION
033 PUSH P,B
034 HRRZ A,(A)
035 JLIST: HLRZ B,(A) ;HACKISH VERSION WHICH DOESN'T
036 PUSH P,B ; EVAL FIRST ARG OR COUNT IT
037 HRRZ A,(A)
038 ILIST: MOVEI T,0 ;CALLED BY JSP TT,ILIST
039 JUMPE A,(TT)
040 PUSH FXP,TT
041 PUSH FXP,T ;CONTAINS 0 - USED AS COUNTER
042 071 024 PUSH FXP,R ;MUST SAVE R!
043 ILIST1: PUSH P,A ;OTHERWISE, THIS EVAL LOOP
044 HLRZ A,(A) ; MAY CLOBBER ANYTHING
045 152 043 PUSHJ P,EVAL
046 ILIST3: EXCH A,(P) ;SAVE VALUE ON STACK
047 HRRZ A,(A)
048 SOS -1(FXP) ;COUNT VALUES
049 068 043 JUMPN A,ILIST1
050 071 024 POP FXP,R ;RESTORE R
051 POP FXP,T ;T HAS -<# OF VALUES ON PDL>
052 POPJ FXP,
053
VARIOUS LISTING AND DE-LISTING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 68.1
054
055 002 048 IFN QIO,[
056
057 ;;; JSP T,GTRDTB ;GETS READTABLE IN AR2A, AND MAYBE CHECKS FOR ERRORS.
058
059 GTRDTB: HRRZ AR2A,VREADTABLE
060 SKIPN V.RSET ;ERROR CHECKS IFF *RSET NON-NIL
061 209 011 JRST (T)
062 SKOTT AR2A,SA
063 068 067 JRST GTRDT8 ;ERROR IF NOT ARRAY
064 MOVE TT,ASAR(AR2A)
065 TLNE TT,AS<RDT> ;ERROR IF NOT READTABLE TYPE ARRAY
066 209 011 JRST (T)
067 GTRDT8: MOVEI AR2A,READTABLE ;ON ERROR, RESTORE TO STANDARD READTABLE
068 EXCH AR2A,VREADTABLE
069 EXCH AR2A,A
070 PUSHJ P,GTRDT9 ;GIVE OUT A FAIL-ACT
071 MOVEI A,(AR2A)
072 068 059 JRST GTRDTB ;TRY AGAIN IF LOSER RETURNS TO US
073
074 ] ;END OF IFN QIO
NOINTERRUPT FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 69
001
002 SUBTTL NOINTERRUPT FUNCTION
003
004 069 018 NOINTERRUPT: JUMPE A,CHECKU ;SUBR 1 - ENABLE/DISABLE
005 CAIN A,QTTY
006 069 048 Q% JRST CHECKA
007 069 018 Q$ JRST CHECKU
008 SETO A, ; RANDOM ASYNCHRONOUS
009 015 026 NOINT0: EXCH A,UNREAL ; "REAL TIME" INTERRUPTS
010 SKIPGE A ; (CLOCKS AND TTY)
011 MOVEI A,TRUTH
012 POPJ P,
013
014 ;;; CHECK FOR ANY DELAYED "REAL TIME" INTERRUPTS, AND RUN THEM
015 ;;; IF ANY. MUST DO THEM IN THE ORDER ↑G/↑X, CLOCKS, AND OTHER.
016 ;;; NOTE THAT AFTER A ↑G OR ↑X, CHECKU GETS CALLED AGAIN.
017
018 015 026 CHECKU: SKIPN UNREAL ;NONE CAN BE PENDING IF NOT DELAYING
019 Q% POPJ P,
020 069 009 Q$ JRST NOINT0
021
022 CHECKQ:
023 Q$ PUSH P,A
024 196 042 PUSHJ P,UINTPU
025 NOINT1: SKIPE (P)
026 069 029 JRST NOINT5
027 028 018 SKIPE D,UNRC.G ;PROCESS ↑G/↑X FIRST
028 201 009 JRST CKI2A ;TOP LEVEL OR ERRRTN WILL DO A CHECKU
029 069 063 NOINT5: PUSHJ P,NOINTA ;NOW PROCESS ALARMCLOCK INTERRUPTS
030 069 025 JRST NOINT1
031 028 023 NOINT3: SKIPG F,UNREAR ;NOW ANY OTHER INTERRUPTS
032 069 041 JRST NOINT4
033 028 023 SOS UNREAR
034 028 023 Q% MOVE A,UNREAR(F)
035 028 023 Q$ MOVE D,UNREAR(F)
036 181 046 Q$ TRNE D,400000 ;IF (NOINTERRUPT 'TTY), SUPPRESS
037 Q$ SKIPN (P) ; TTY INTERRUPTS AT THIS TIME
038 197 008 PUSHJ P,YESINT ;FOR QIO, MAY CLOBBER R (SEE UISTAK)
039 069 025 JRST NOINT1
040
041 015 026 NOINT4: SKIPG A,UNREAL
042 MOVEI A,TRUTH
043 015 026 Q% SETZM UNREAL
044 015 026 Q$ POP P,UNREAL
045 196 017 JRST UINTEX
046
047 002 048 IFE QIO,[
048 015 026 CHECKA: SKIPL UNREAL
049 069 009 JRST NOINT0
050 196 042 CHECKZ: PUSHJ P,UINTPU
051 069 063 PUSHJ P,NOINTA
052 209 011 JRST .-1
053 MOVEI A,QTTY
NOINTERRUPT FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 69.1
054 015 026 MOVEM A,UNREAL
055 MOVEI A,TRUTH
056 196 017 JRST UINTEX
057 ] ;END OF IFE QIO
058
059 ;;; DO NOT TRANSFORM THE "PUSHJ, POPJ" SEQUENCES INTO "JRST".
060 ;;; YESINT DEPENDS ON LOOKING AT THE PUSHJ ADDRESS TO SEE WHETHER
061 ;;; WE CAME FROM NOINTERRUPT OR ELSEWHERE!
062
063 NOINTA:
064 028 021 Q% SKIPN A,UNRRUN ;PROCESS RUNTIME ALARMCLOCK FIRST
065 028 021 Q$ SKIPN D,UNRRUN
066 069 070 JRST NOINT2
067 028 021 SETZM UNRRUN
068 197 008 PUSHJ P,YESINT
069 POPJ P,
070 NOINT2:
071 028 022 Q% SKIPN A,UNRTIM ;NOW THE REAL TIME ALARMCLOCK
072 028 022 Q$ SKIPN D,UNRTIM
073 059 039 JRST POPJ1
074 028 022 SETZM UNRTIM
075 197 008 PUSHJ P,YESINT
076 POPJ P,
077
078 198 027 ENOINT::. .SEE UINT0N
CAR/CDR ROUTINES AND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 70
001
002 SUBTTL CAR/CDR ROUTINES AND FUNCTIONS
003
004 ;;; HERE BELOW FOLLOW THE "FAST" CAR-CDR ROUTINES,
005 ;;; USED WHEN *RSET=NIL, AND BY COMPILED CODE.
006 ;;; NOTE THAT THE RELATIVE DISPLACEMENT OF THE FUNCTION ENTRY POINTS
007 ;;; IS VERRRRRY IMPORTANT TO THE POOOR COMPLR.
008 ;;; DONT EVER CHANGE THEM!!
009
010 CARCDR: ;INDEX NUMBER FOR CALL BY COMPILED CODE
011 %CADDDR: SKIPA A,(A) ; 0
012 %CADDAR: HLRZ A,(A) ; 1
013 %CADDR: SKIPA A,(A) ; 2
014 %CADAR: HLRZ A,(A) ; 3
015 %CADR: SKIPA A,(A) ; 4
016 %CAAR: HLRZ A,(A) ; 5
017 %CAR: HLRZ A,(A) ; 6
018 209 011 JRST (T)
019 %CDDDDR: SKIPA A,(A) ; 8
020 %CDDDAR: HLRZ A,(A) ; 9
021 %CDDDR: SKIPA A,(A) ;10.
022 %CDDAR: HLRZ A,(A) ;11.
023 %CDDR: SKIPA A,(A) ;12.
024 %CDAR: HLRZ A,(A) ;13.
025 %CDR: HRRZ A,(A) ;14.
026 209 011 JRST (T)
027 %CAADDR: SKIPA A,(A) ;16.
028 %CAADAR: HLRZ A,(A) ;17.
029 %CAADR: SKIPA A,(A) ;18.
030 %CAAAR: HLRZ A,(A) ;19.
031 070 016 JRST %CAAR
032 %CDADDR: SKIPA A,(A) ;21.
033 %CDADAR: HLRZ A,(A) ;22.
034 %CDADR: SKIPA A,(A) ;23.
035 %CDAAR: HLRZ A,(A) ;24.
036 070 024 JRST %CDAR
037 %CAAADR: SKIPA A,(A) ;26.
038 %CAAAAR: HLRZ A,(A) ;27.
039 070 030 JRST %CAAAR
040 %CDDADR: SKIPA A,(A) ;29.
041 %CDDAAR: HLRZ A,(A) ;30.
042 070 022 JRST %CDDAR
043 %CDAADR: SKIPA A,(A) ;32.
044 %CDAAAR: HLRZ A,(A) ;33.
045 070 035 JRST %CDAAR
046 %CADADR: SKIPA A,(A) ;35.
047 %CADAAR: HLRZ A,(A) ;36.
048 070 014 JRST %CADAR
049
CAR/CDR ROUTINES AND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 71
001
002 ;;; THE FOLLOWING TABLE IS A TRANSFER VECTOR: GIVEN THE INFO-NUMBER
003 ;;; OF A CAR-CDR OPERATION, SAY N, THEN CARCDR[N-2] IS THE
004 ;;; ADDRESS OF THE FAST ROUTINE FOR THAT OPERATION. NOTE THAT THE
005 ;;; INFO-NUMBER IS NOT THE SAME AS THE INDEX-NUMBER-FOR-COMPILED-CODE
006
007 %CARCDR:
008 181 046 IRP X,,[A,D,AA,AD,DA,DD
009 AAA,AAD,ADA,ADD,DAA,DAD,DDA,DDD
010 AAAA,AAAD,AADA,AADD,ADAA,ADAD,ADDA,ADDD
011 DAAA,DAAD,DADA,DADD,DDAA,DDAD,DDDA,DDDD]
012 071 024 %C!X!R
013 TERMIN
014
015 ;;; STANDARD INTERPRETER SUBRS FOR THE VARIOUS CAR-CDR
016 ;;; OPERATIONS. THESE CALL A CENTRAL DECODER WHICH IN *RSET
017 ;;; MODE PERFORMS TYPE CHECKING ON THE OPERAND AT EACH STEP.
018
019 CRSUBRS:
020 181 046 IRP X,,[A,D,AA,AD,DA,DD
021 AAA,AAD,ADA,ADD,DAA,DAD,DDA,DDD
022 AAAA,AAAD,AADA,AADD,ADAA,ADAD,ADDA,ADDD
023 DAAA,DAAD,DADA,DADD,DDAA,DDAD,DDDA,DDDD]
024 071 056 C!X!R: JSP F,CR0
025 TERMIN
026
027 ;;; LET A=0, D=1, AND LET CWXYZR BE A CAR-CDR OPERATION, WITH
028 ;;; THE VARIABLES W,X,Y,Z RANGING OVER {,A,D}. LET A NUMBER N
029 ;;; BE COMPUTED CORRESPONDING TO CXYZWR AS FOLLOWS:
030 ;;; N = Z + 2 IF W,X,Y ARE NULL
031 ;;; N = Y*2 + Z + 4 IF W,X ARE NULL
032 ;;; N = X*4 + Y*2 + Z + 10 IF W IS NULL
033 ;;; N = W*10 + X*4 + Y*2 + Z + 20 IF NONE OF W,X,Y,Z ARE NULL
034 ;;; NOTE TWO THINGS:
035 ;;; [1] THIS REPRESENTATION OF A CAR-CDR OPERATION IS EASILY
036 ;;; BITWISE DECODABLE. THE POSITION OF THE FIRST 1 BIT
037 ;;; INDICATES THE START OF THE REST OF THE ENCODING, WHICH HAS
038 ;;; 0 FOR CAR, 1 FOR CDR AT EACH POSITION.
039 ;;; [2] FOR ANY SET OF OPERATIONS COMPLETE FROM CAR AND CDR,
040 ;;; THROUGH CAAR, CADR, ... TO "LEVEL M" CAR-CDR'S (THOSE WITH
041 ;;; M A'S AND D'S), THIS ENCODING PRODUCES A COMPACT ENCODING,
042 ;;; M+1
043 ;;; WITH N RANGING FROM 2 TO 2 -1 INCLUSIVE.
044 ;;;
045 ;;; NAME N (OCTAL) N (BINARY)
046 ;;; CAR 2 10
047 ;;; CDR 3 11
048 ;;; CAAR 4 100
049 ;;; CADR 5 101
050 ;;; . . .
051 ;;; CDDADR 35 11101
052 ;;; CDDDAR 36 11110
053 ;;; CDDDDR 37 11111
CAR/CDR ROUTINES AND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 71.1
054
055
056 CR0: SKIPE V.RSET
057 071 061 JRST CR1
058 POP P,T
059 071 019 JRST @%CARCDR-<CRSUBRS+1>(F) ;QUICK VERSION FOR *RSET = NIL
060
061 060 041 CR1: PUSHJ P,SAVX3 ;***** LOSS! GO AWAY WHEN COMPILER IS SMARTER.
062 181 046 CR1A: MOVEI D,(A)
063 071 019 2DIF [MOVEI T,(F)]400002,CRSUBRS+1 ;400000 IS FOR CA.DER
064 181 046 CR2: SKOTT D,LS ;CHECK FOR LIST TYPE
065 071 075 JRST CR4
066 CR3: TRNE T,1 ;SKIP IF CAR OPERATION
067 181 046 SKIPA D,(D)
068 181 046 HLRZ D,(D)
069 ROT T,-1
070 TRNE T,776 ;SKIP IF ALL DONE
071 071 064 JRST CR2
072 181 046 CR7: MOVEI A,(D)
073 060 053 JRST RSTX3 ;***** LOSS! GO AWAY WHEN COMPILER IS SMARTER
074
075 CR4: TRNE T,1 ;IF NEXT ARG ISN'T A LIST
076 071 024 SKIPA R,VCDR ;THEN CHECK OUT AGAINST PERMISSIBLITIES
077 071 024 MOVE R,VCAR
078 071 083 JUMPN R,CR5
079 181 046 TRNN D,-1 ;IF ONLY NIL AND LISTS PERMISSIBLE
080 071 072 JRST CR7 ;THEN LET NIL BECOME NIL (CAR NIL) = (CDR NIL) = NIL
081 209 011 JRST CA.DER ;ELSE, BOMB OUT
082
083 071 024 CR5: CAIE R,QSYMBOL
084 071 090 JRST CR6
085 181 046 TRNE D,-1
086 TLNE TT,SY
087 071 066 JRST CR3
088 209 011 JRST CA.DER ;LOSE IF NEITHER NIL NOR SYMBOL
089
090 071 024 CR6: CAIN R,QLIST
091 209 011 JRST CA.DER ;LIST TEST ON ARG HAS ALREADY FAILED, SO FAIL
092 071 066 JRST CR3 ;IF CAR,CDR NOT "LIST", "SYMBOL", OR "NIL", THEN OK FOR ANYTHING
SYMBOL CONSER LISP.393[MAC,LSP] 01/17/78 Page 72
001
002 SUBTTL SYMBOL CONSER
003
004 022 019 PNGNK: ADDI C,PNBUF-1 ;USED ONLY BY INTERN - PURIFIES PNAME IF RELEVANT
005 021 012 SKIPGE LPNF ;IF LPNF IS NEGATIVE, THE PNAME IS IN PNBUF,
006 072 049 PUSHJ P,PNCONS ; SO WE CONS IT UP NOW
007 SKIPE V.PURE
008 PUSHJ P,PURCOPY ;MAKE A PURE COPY IF DESIRED
009 072 013 JRST SYCONS
010
011 021 012 PNGNK1: SKIPGE LPNF ;CONS UP PNAME IF NECESSARY
012 072 049 PNGNK2: PUSHJ P,PNCONS
013 SYCONS: ;CONS UP A SYMBOL - PNAME LIST IS IN A
014 BAKPRO
015 023 021 SKIPN FFY ;IF SYMBOL FREELIST EMPTY, GO DO A GC
016 072 033 JRST SYCON1
017 SKIPE V.PURE ;IF *PURE IS NON-NIL, WE WANT
018 072 036 JRST SYCON4 ; A PURE SYMBOL BLOCK
019 023 025 SKIPN B,FFY2 ;IF SYMBOL BLOCK FREELIST EMPTY, MUST GC
020 072 033 JRST SYCON1
021 MOVEM A,1(B) ;PUT PNAME IN SYMBOL BLOCK
022 MOVE A,[777000,,SUNBOUND] ;INITIAL VALUE CELL IS SUNBOUND
023 XCTPRO
024 EXCH A,(B) ;PUT IN SYMBOL BLOCK
025 023 025 MOVEM A,FFY2 ;CDR SYMBOL BLOCK FREELIST
026 SYCON2: MOVSI A,(B) ;INITIAL PROPERTY LIST IS NIL
027 023 021 EXCH A,@FFY ;CONS UP SYMBOL HEADER
028 023 021 EXCH A,FFY
029 NOPRO
030 POPJ P,
031
032 226 006 SPECPRO INTSYX
033 SYCON1: PUSHJ P,AGC
034 072 013 JRST SYCONS
035
036 023 046 SYCON4: AOSL B,NPFFY2 ;CONS UP A PURE SYMBOL BLOCK
037 226 005 SPECPRO INTSYQ
038 PUSHJ P,GTNPSG
039 023 061 ADD B,EPFFY2
040 023 046 AOS NPFFY2
041 226 004 SPECPRO INTSYP
042 MOVEM A,1(B)
043 MOVE A,[777200,,SUNBOUND] ;200 BIT SAYS MAYBE READ-ONLY
044 MOVEM A,(B)
045 072 026 JRST SYCON2
046 NOPRO
047
048
049 PNCONS: PUSH FXP,T ;CONS A PNAME LIST OUT OF PNBUF
050 MOVEI A,NIL
051 022 019 2DIF [MOVEI C,(C)]1,PNBUF
052 PNG2: MOVE B,A
053 022 019 MOVE TT,PNBUF-1(C)
SYMBOL CONSER LISP.393[MAC,LSP] 01/17/78 Page 72.1
054 074 015 JSP T,FWCONS
055 073 010 PUSHJ P,CONS
056 072 052 SOJG C,PNG2
057 060 050 CPXTJ: JRST POPXTJ
LIST SPACE CONSERS LISP.393[MAC,LSP] 01/17/78 Page 73
001
002 SUBTTL LIST SPACE CONSERS
003
004 ;;; THIS SET OF CONSERS IS USED WITHIN THE LISP SYSTEM.
005 ;;; ONLY A AND B ARE CLOBBERED, AND THE ARGUMENTS MUST NOT
006 ;;; BE PDL QUANTITIES.
007
008 NCONS: TRZA B,-1 ;(NCONS A) = (CONS A NIL)
009 XCONS: EXCH B,A ;(XCONS A B) = (CONS B A)
010 CONS: HRL B,A
011 226 023 SPECPRO INTC2X
012 023 014 CONS1: SKIPN A,FFS ;SKIP UNLESS FREELIST EMPTY
013 073 021 JRST CONS3
014 EXCH B,(A) ;PUT POINTERS IN CELL, GET CDR OF FREELIST
015 XCTPRO
016 023 014 EXCH B,FFS ;CDR FREELIST, COPY OF CELL POINTER TO B
017 NOPRO ; (BUT NO ONE CURRENTLY TAKES ADVANTAGE OF IT)
018 POPJ P,
019
020 226 023 SPECPRO INTC2X
021 CONS3: HLR A,B ;DO THIS TO PROTECT POINTERS FROM GC
022 PUSHJ P,AGC ;PERFORM A GARBAGE COLLECTION
023 NOPRO
024 073 012 JRST CONS1 ;GO TRY AGAIN
025
026 ;;; THIS SET OF CONSERS IS THE SET AVAILABLE TO INTERPRETED CODE.
027 ;;; THEY MAKE SURE THAT PDL QUANTITIES DO NOT GET INTO LIST STRUCTURE.
028
029 $NCONS: TRZA B,-1 ;SUBR 1
030 $CONS: EXCH A,B ;SUBR 2
031 094 012 $XCONS: JSP T,PDLNMK ;SUBR 2
032 EXCH A,B
033 094 012 JSP T,PDLNMK
034 073 010 JRST CONS
035
036 ;;; THIS SET OF CONSERS IS CALLED FROM COMPILED CODE.
037 ;;; ARGUMENTS MUST NOT BE PDL QUANTITIES.
038 ;;; THESE ARE SLIGHTLY FASTER, SINCE T IS USED FOR JSP.
039
040 %NCONS: TRZA B,-1 ;(NCONS A) = (CONS A NIL)
041 %XCONS: EXCH B,A ;(XCONS A B) = (CONS B A)
042 %CONS: HRL B,A
043 226 023 SPECPRO INTC2X
044 023 014 %CONS1: SKIPN A,FFS ;SKIP UNLESS FREELIST EMPTY
045 073 053 JRST %CONS3
046 EXCH B,(A) ;PUT POINTERS IN CELL, GET CDR OF FREELIST
047 XCTPRO
048 023 014 EXCH B,FFS ;CDR FREELIST, COPY OF CELL POINTER TO B
049 NOPRO ; (BUT NO ONE CURRENTLY TAKES ADVANTAGE OF IT)
050 209 011 JRST (T)
051
052 226 023 SPECPRO INTC2X
053 %CONS3: HLR A,B ;DO THIS TO PROTECT POINTERS FROM GC
LIST SPACE CONSERS LISP.393[MAC,LSP] 01/17/78 Page 73.1
054 PUSHJ P,AGC ;PERFORM A GARBAGE COLLECTION
055 NOPRO
056 073 044 JRST %CONS1 ;GO TRY AGAIN
NUMBER CONSERS LISP.393[MAC,LSP] 01/17/78 Page 74
001
002 SUBTTL NUMBER CONSERS
003
004
005 064 022 FIX2: JSP T,IFIX ;FLONUM TO FIXNUM CONVERSION, FXCONS, POPJ
006 FIX1: POP P,T ;FXCONS, THEN POPJ
007 FXCONS: ;FIXNUM CONS - MAY UNIQUIZE
008 FIX1A: CAIGE TT,XHINUM ;IF WITHIN THE RANGE OF THE
009 CAMGE TT,[-XLONUM] ; BUILT-IN TABLE OF UNIQUE FIXNUMS,
010 074 015 JRST FWCONS ; THEN NEEDN'T DO A REAL CONS
011 MOVEI A,IN0(TT) ;JUST PROVIDE A POINTER INTO THE TABLE
012 209 011 JRST (T)
013
014 226 035 SPECPRO INTZAX
015 023 015 FWCONS: SKIPN A,FFX ;FULL WORD CONS - ALWAYS CONSES
016 JSP A,AGC4
017 EXCH TT,(A)
018 XCTPRO
019 023 015 EXCH TT,FFX
020 NOPRO
021 209 011 JRST (T)
022
023
024
025 074 030 FLCONX: AOJA T,FLCONS ;FLCONS WITH SKIP RETURN
026
027 064 031 FLOAT2: JSP T,IFLOAT ;FIXNUM TO FLONUM, FLCONS, POPJ
028 FLOAT1: POP P,T ;FLCONS, THEN POPJ
029 226 035 SPECPRO INTZAX
030 FLCONS: ;FLONUM CONS
031 023 016 FPCONS: SKIPN A,FFL
032 JSP A,AGC4
033 EXCH TT,(A)
034 XCTPRO
035 023 016 EXCH TT,FFL
036 NOPRO
037 209 011 JRST (T)
NUMBER CONSERS LISP.393[MAC,LSP] 01/17/78 Page 75
001
002 002 068 IFN DBFLAG,[
003 DBL1: POP P,T
004 226 035 SPECPRO INTZAX
005 023 017 DBCONS: HRRZS FFD ;DOUBLE PRECISION CONSER
006 023 017 SKIPN A,FFD
007 JSP A,AGC4
008 EXCH TT,(A)
009 XCTPRO
010 023 017 EXCH TT,FFD
011 NOPRO
012 181 046 MOVEM D,1(A)
013 209 011 JRST (T)
014 ] ;END OF IFN DBFLAG
015 002 068 IFE DBFLAG,[
016 DBCONS: PUSH P,T
017 DBL1: MOVEI A,QDOUBLE ;ERROR IF DOUBLES NOT IMPLEMENTED
018 %FAC NUM1MS
019 ] ;END OF IFE DBFLAG
020
021
022 002 069 IFN CXFLAG,[
023 075 027 CXCONX: AOJA T,CXCONS ;CXCONS WITH SKIP RETURN
024
025 CMPL1: POP P,T
026 226 035 SPECPRO INTZAX
027 023 018 CXCONS: HRRZS FFC ;COMPLEX NUMBER CONSER
028 023 018 SKIPN A,FFC
029 JSP A,AGC4
030 EXCH TT,(A)
031 XCTPRO
032 023 018 EXCH TT,FFC
033 NOPRO
034 181 046 MOVEM D,1(A)
035 209 011 JRST (T)
036 ] ;END OF IFN CXFLAG
037 002 069 IFE CXFLAG,[
038 CXCONS: PUSH P,T
039 CMPL1: MOVEI A,QCOMPLEX ;ERROR IS COMPLEX NUMBERS NOT IMPLEMENTED
040 %FAC NUM1MS
041 ] ;END OF IFE CXFLAG
042
043
044 005 046 IFN DXFLAG,[
045 DUPL1: POP P,T
046 226 035 SPECPRO INTZAX
047 023 019 DXCONS: HRRZS FFZ ;DOUBLE-PRECISION COMPLEX NUMBER CONSER
048 023 019 SKIPN A,FFZ
049 JSP A,AGC4
050 071 024 EXCH R,(A)
051 XCTPRO
052 023 019 EXCH R,FFZ
053 NOPRO
NUMBER CONSERS LISP.393[MAC,LSP] 01/17/78 Page 75.1
054 MOVEM F,1(A)
055 KA MOVEM TT,2(A)
056 181 046 KA MOVEM D,3(A)
057 KIKL DMOVEM TT,2(A)
058 209 011 JRST (T)
059 ] ;END OF IFN DXFLAG
060 005 046 IFE DXFLAG,[
061 DXCONS: PUSH P,T
062 DUPL1: MOVEI A,QDUPLEX ;ERROR IF DUPLICES NOT IMPLEMENTED
063 %FAC NUM1MS
064 ] ;END OF IFE DXFLAG
HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 76
001
002 SUBTTL HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY
003
004
005 002 050 IFE HNKLOG,[
006 %HUNK3:
007 %HUNK4:
008 %CXR:
009 079 036 %RPX: LERR [SIXBIT \NO HUNKS IN THIS LISP - HUNK/CXR/RPLACX!\]
010 ] ;END OF IFE HNKLOG
011
012
013 002 050 IFN HNKLOG,[
014
015 065 007 CXR: JSP T,FXNV1 ;SUBR 2
016 SKIPE V.RSET
017 076 052 JSP F,CXR3 ;CHECK ARGS
018 ROT TT,-1
019 ADDI TT,(B)
020 076 024 JUMPGE TT,CXR2
021 HLRZ A,(TT) ;ODD-NUMBERED COMPONENTS IN LEFT HALVES
022 POPJ P,
023
024 CXR2: HRRZ A,(TT) ;EVEN-NUMBERED COMPONENTS IN RIGHT HALVES
025 POPJ P,
026
027
028 035 006 RPLACX: EXCH A,C ;SUBR 3
029 094 012 JSP T,PDLNMK ;SIGH - MUST PDLNMK THE DATUM
030 035 006 EXCH A,C
031 065 007 JSP T,FXNV1
032 SKIPE V.RSET
033 076 052 JSP F,CXR3 ;CHECK ARGS
034 ROT TT,-1
035 ADDI TT,(B)
036 076 040 JUMPGE TT,RPLX2
037 035 006 HRLM C,(TT)
038 084 033 JRST BRETJ ;RETURN SECOND ARG
039
040 035 006 RPLX2: HRRM C,(TT)
041 084 033 JRST BRETJ
042
043
044 CXR30: TLNN T,$FS+VC ;A LIST CELL OR VALUE CELL IS OKAY
045 076 049 JRST CXR31 ; IF THE INDEX IS 0 OR 1
046 076 061 JUMPL TT,CXR33
047 CAIG TT,1
048 209 011 JRST (F)
049 CXR31: EXCH A,B
050 079 036 WTA [INVALID OR WRONG LENGTH HUNK!]
051 EXCH A,B
052 CXR3: MOVEI T,(B) ;CHECKING ROUTINE FOR CXR/RPLACX
053 005 042 LSH T,-SEGLOG
HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 76.1
054 036 033 MOVE T,ST(T)
055 TLNN T,HNK ;SECOND ARG MUST BE HUNK
056 076 044 JRST CXR30
057 181 046 MOVEI D,4
058 181 046 2DIF [LSH D,(T)]0,QHUNK1
059 181 046 CAMLE D,TT ;FIRST ARG MUST BE SMALLER THAN
060 076 064 JUMPGE TT,CXR34 ; LENGTH OF SECOND, YET NON-NEGATIVE
061 079 036 CXR33: WTA [BAD HUNK INDEX!]
062 209 011 JRST -3(F)
063
064 181 046 CXR34: MOVE D,TT ;EVERYTHING IS APPARENTLY OKAY
065 181 046 ROT D,-1
066 181 046 ADDI D,(B)
067 181 046 HRRZ T,(D) ;FETCH COMPONENT IN QUESTION
068 181 046 SKIPGE D
069 181 046 HLRZ T,(D)
070 CAIN T,-1 ;ERROR IF AN UNUSED COMPONENT
071 076 061 JRST CXR33
072 209 011 JRST (F)
HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 77
001
002 ;;; IFN HNKLOG
003
004 ;;; CXR ROUTINE FOR COMPILED CODE. HUNK IN A, INDEX IN TT.
005
006 %CXR: ROT TT,-1 ;QUICK ENTRY FOR COMPILED CALLS
007 ADDI TT,(A)
008 077 012 JUMPGE TT,%CXR2
009 HLRZ A,(TT)
010 209 011 JRST (T)
011
012 %CXR2: HRRZ A,(TT)
013 209 011 JRST (T)
014
015 ;;; RPLACX ROUTINE FOR COMPILED CODE.
016 ;;; HUNK IN A, DATUM IN B, INDEX IN TT.
017 ;;; THE DATUM IS GUARANTEED NOT TO BE A PDL QUANTITY.
018
019 %RPX: ROT TT,-1 ;HUNK SUBSCRIPT IS PASSED IN TT
020 ADDI TT,(A)
021 077 025 JUMPGE TT,%RPX2
022 HRLM B,(TT)
023 209 011 JRST (T)
024
025 %RPX2: HRRM B,(TT)
026 209 011 JRST (T)
027
028 ;;; HUNK3 AND HUNK4 ROUTINES FOR COMPILED CODE.
029 ;;; THESE ALLOCATE HUNKS OF SIZE 3 AND 4 SUPER-QUICKLY.
030 ;;; ARGUMENTS IN A, B, C, AR1, GUARANTEED NOT TO BE PDL QUANTITIES.
031
032 035 006 %HUNK3: EXCH C,AR1 ;HUNK3 IS JUST HUNK4, WITH ONE UNUSED COMPONENT,
033 035 006 TROA C,-1 ; BUT UNFORTUNATELY MUST SHUFFLE ARGS
034 %HNK4A: PUSHJ P,AGC
035 BAKPRO
036 023 022 %HUNK4: HRRZS FFH ;HUNK4 IS THE IMPORTANT CASE
037 023 022 SKIPN FFH
038 077 034 JRST %HNK4A
039 023 022 EXCH A,@FFH
040 XCTPRO
041 023 022 EXCH A,FFH
042 MOVSS (A)
043 HRRZM B,1(A)
044 035 006 HRLM C,1(A)
045 HRRM AR1,(A)
046 NOPRO
047 209 011 JRST (T)
HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 78
001
002 ;;; IFN HNKLOG
003
004 079 036 HNKSZ0: WTA [NOT A HUNK - HUNKSIZE!]
005 078 008 JRST HNKSZ1
006 HUNKSIZE: ;SUBR 1 - NCALLABLE
007 064 007 PUSH P,CFIX1
008 HNKSZ1: MOVEI T,(A)
009 005 042 LSH T,-SEGLOG
010 036 033 SKIPL T,ST(T)
011 078 004 JRST HNKSZ0
012 MOVEI TT,2 ;RANDOM CONSES ARE OF SIZE 2
013 TLNN T,HNK
014 POPJ P,
015 181 046 MOVEI D,1
016 2DIF [LSHC TT,(T)]0,QHUNK1-1
017 181 046 ADDI D,-1(A)
018 071 024 HNKSZ3: SETCM R,(D) ;OTHERWISE CALCULATE LENGTH
019 071 024 TLNE R,-1
020 POPJ P,
021 071 024 TRNE R,-1
022 059 031 SOJA TT,CPOPJ
023 181 046 SUBI D,1
024 SUBI TT,2
025 078 018 JUMPG TT,HNKSZ3
026 .VALUE
027
028
029 005 042 HUNKP: LSH A,-SEGLOG ;SUBR 1
030 036 033 SKIPGE A,ST(A)
031 TLNN A,HNK
032 081 044 JRST FALSE
033 086 011 JRST TRUE
034
035
036 ;;; HUNKN IS THE CONSER FOR HUNKS OF SIZE 2↑N WORDS.
037
038 002 050 REPEAT HNKLOG,[
039 226 035 SPECPRO INTZAX
040 079 036 CONC HUNK,\.RPCNT+1,: ;VARIOUS HUNK CONSERS
041 023 022 HRRZS FFH+.RPCNT ;FLUSH SIGN BIT - NEED A HUNK NOW
042 023 022 SKIPN A,FFH+.RPCNT
043 JSP A,AGC4
044 MOVE TT,(A)
045 XCTPRO
046 023 022 MOVEM TT,FFH+.RPCNT
047 REPEAT 2←.RPCNT, SETOM .RPCNT(A) ;MUST FILL OUT COMPONENTS
048 NOPRO ; WITH THE "UNUSED" POINTER
049 POPJ P,
050 ] ;END OF REPEAT HNKLOG
HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 79
001
002 ;;; IFN HNKLOG
003
004 079 005 XHUNK0: WTA [BAD ARGUMENT TO MAKHUNK!]
005 MAKHUNK: SKOTT A,FX ;SUBR 1
006 079 034 JRST XHUNK5
007 SKIPGE TT,(A)
008 079 004 JRST XHUNK0
009 002 050 CAILE TT,2←HNKLOG ;CREATE HUNK WITH N COMPONENTS
010 079 004 JRST XHUNK0 ; INITIALIZED TO NIL
011 081 044 SOJL TT,FALSE
012 MOVEI T,1(TT)
013 079 024 PUSHJ P,XHUNK1
014 LSHC T,-1
015 079 020 JUMPE T,XHUNK6 ;BEWARE IF 1 OR 0 ELEMENTS
016 HRLOI T,-1(T) ;SEE HAKMEM FOR THIS EQVI HAK
017 EQVI T,(A)
018 SETZM (T)
019 AOBJN T,.-1
020 XHUNK6: SKIPGE TT
021 HLLZS (T)
022 POPJ P,
023
024 079 026 XHUNK1: JFFO TT,XHUNK2 ;SELECT CONSER FOR CORRECT SIZE HUNK
025 051 010 JRA A,ACONS
026 002 050 XHUNK2: JRST .+1-43+HNKLOG(D)
027 IRP X,,[1024,512,256,128,64,32,16,8,4]Y,,[9,8,7,6,5,4,3,2,1]
028 002 050 IFG Y-HNKLOG, .STOP
029 079 036 JRST HUNK!Y ;2↑<Y+1> THINGS
030 TERMIN
031 051 010 JRA A,ACONS ;2 THINGS - USE CONS
032
033
034 079 004 XHUNK5: JUMPGE TT,XHUNK0 .SEE LS
035 158 022 JSP TT,AP2 ;STACK LIST ON PDL, -COUNT IN T
036 081 044 HUNK: AOJG T,FALSE ;LSUBR
037 PUSH FXP,T ;WE MUST PDLNMK ALL THE ARGUMENTS!
038 181 046 MOVEI D,(P)
039 181 046 ADDI D,(T)
040 181 046 HRLI D,-1(T)
041 181 046 HUNK53: SKIPE A,(D) ;MIGHT AS WELL BE CLEVER ABOUT NIL - IT'S CHEAP
042 094 012 JSP T,PDLNMK
043 181 046 MOVEM A,(D)
044 079 041 AOBJN D,HUNK53
045 POP FXP,T ;ALL DONE PDLNMK'ING
046 079 057 JUMPE T,POPNCONS
047 MOVNS TT,T ;CREATE HUNK BIG ENOUGH TO
048 181 046 MOVEI D,QHUNK ; HOLD ALL GIVEN ARGUMENTS,
049 002 050 CAIL TT,2←HNKLOG ; AND INSTALL THEM
050 079 054 JRST XHUNK7
051 079 060 JSP AR2A,HUNKF0
052 POPJ P,
053
HUNK PRIMITIVES - CXR, RPLACX, HUNK<N>, HUNK, HUNKIFY LISP.393[MAC,LSP] 01/17/78 Page 79.1
054 XHUNK7: MOVNS T
055 SOJA T,WNALOSE
056
057 POPNCONS: POP P,A
058 051 010 JRST ACONS
059
060 079 024 HUNKF0: PUSHJ P,XHUNK1 ;CREATE A FRESH HUNK, AND INSTALL ARGS FROM PDL
061 POP P,B ;ALSO USED BY FASLOAD
062 HRRM B,(A) ;LAST ONE GOES IN ELEMENT 0
063 LSHC T,-1 ;SAVES C
064 181 046 MOVEI D,(A) .SEE LDLHNK
065 181 046 ADDI D,(T) ;NO ARGUMENT MAY BE A PDL QUANTITY
066 079 069 JUMPGE TT,HUNKF3
067 HUNKF2: POP P,B ;LOOP TO INSTALL ARGS IN HUNK
068 181 046 HRLM B,(D)
069 HUNKF3: SOJL T,(AR2A)
070 POP P,B
071 181 046 HRRM B,(D)
072 079 067 SOJA D,HUNKF2
073
074 ] ;END OF IFN HNKLOG
ATOM, PLIST, SETPLIST, ASSOC AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 80
001
002 SUBTTL ATOM, PLIST, SETPLIST, ASSOC AND FRIENDS
003
004
005 005 042 ATOM: LSH A,-SEGLOG ;CAN DO LSH HERE BECAUSE DON'T NEED ARG
006 036 033 SKIPGE ST(A) ;FALSE ONLY FOR NON-ATOMIC
007 TDZA A,A ; FREE-STORAGE POINTERS
008 MOVEI A,TRUTH
009 POPJ P,
010
011
012 LATOM: ;SKIP IF EQ TEST IS SUFFICIENT FOR EQUALITY
013 SPATOM: JUMPE A,1(T) ;SKIP IF NIL (WHICH IS SYMBOL)
014 SPAT1: SKOTT A,SY ;LEAVES TYPE BITS IN TT
015 209 011 JRST (T)
016 209 011 JRST 1(T)
017
018
019 080 026 PRPLSE: JUMPE A,PRPNIL
020 %WTA NASER
021 PLIST: SKOTT A,SY+LS ;SUBR 1 - FETCH PROPERTY LIST
022 080 019 JRST PRPLSE
023 HRRZ A,(A)
024 POPJ P,
025
026 PRPNIL: HRRZ A,NILPROPS ;SPECIAL HACK FOR NIL
027 POPJ P,
028
029
030 080 038 RPLIZ: JUMPE A,RPSNIL
031 %WTA NASER
032 SETPLIST:
033 SKOTT A,SY+LS ;SUBR 2 - SET PROPERTY LIST
034 080 030 JRST RPLIZ
035 HRRM B,(A)
036 POPJ P,
037
038 RPSNIL: HRRM B,NILPROPS ;SPECIAL HACK FOR NIL
039 POPJ P,
040
041
042 STENT: MOVEI TT,(A) ;GET ST ENTRY FOR A IN TT
043 005 042 LSH TT,-SEGLOG ;FOR USE WHERE SPACE MORE IMPORTANT THAN TIME
044 036 033 MOVE TT,ST(TT)
045 209 011 JRST (T)
ATOM, PLIST, SETPLIST, ASSOC AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 81
001
002 081 042 SASSQ: SKIPA AR1,ASSQ
003 081 009 SASSOC: MOVEI AR1,SAS2
004 035 006 PUSH P,C
005 PUSHJ P,(AR1)
006 CALLF 0,@(P)
007 059 040 JRST POP1J
008
009 SAS2: MOVE AR1,B ;CHECK TO SEE WHETHER ASSOC CAN BE CONVERTED
010 080 012 JSP T,LATOM ;INTO AN ASSQ
011 081 027 JRST SAS3A
012 SAS0: SKIPE V.RSET
013 081 048 JSP T,SAS4
014 059 031 SAS1: JUMPE B,CPOPJ ;ASSOC USING AN EQ TEST, I.E. ASSQ
015 MOVS T,(B) ;MUST PRESERVE AR2A - SEE FASLAP
016 HLRZ TT,(T)
017 CAIN A,(TT)
018 081 022 JRST SAS1A
019 SAS1C: HLRZ B,T
020 081 014 JRST SAS1
021
022 SAS1A: HRRZ A,T
023 081 019 JUMPE A,SAS1C
024 SAS1B: POP P,T
025 209 011 JRST 1(T)
026
027 SAS3A: SKIPE V.RSET
028 081 048 JSP T,SAS4
029 035 006 SKIPA C,A
030 SAS3: HRRZ AR1,(AR1) ;THE FULL ASSOC THING USING EQUAL
031 059 031 JUMPE AR1,CPOPJ ;SAVE R - SEE SSGCPRO
032 035 006 MOVE A,C
033 HLRZ B,(AR1)
034 081 030 JUMPE B,SAS3
035 HLRZ B,(B)
036 088 004 PUSHJ P,EQUAL
037 081 030 JUMPE A,SAS3
038 HLRZ A,(AR1)
039 081 024 JRST SAS1B
040
041 081 003 ASSOC: SKIPA T,SASSOC
042 081 012 ASSQ: MOVEI T,SAS0 ;** NOTE - MUST NOT USE OTHER THAN A, B, TT
043 PUSHJ P,(T) ;** BECAUSE OF ASSQ'S FOR READ CHAR MACROS
044 FALSE: MOVEI A,0
045 POPJ P,
046
047
048 SAS4: JUMPE B,(T)
049 SKOTT B,LS
050 209 011 JRST SASERR
051 HLRZ TT,(B)
052 JUMPE TT,(T)
053 SKOTT TT,LS+SY
ATOM, PLIST, SETPLIST, ASSOC AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 81.1
054 209 011 JRST SASERR
055 209 011 JRST (T)
GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 82
001
002 SUBTTL GET, GETL, PUTPROP, REMPROP FUNCTIONS
003
004 GET: SKOTT A,LS+SY
005 082 020 JRST GET3
006 CAIN B,QVALUE ;CROCK CROCK CROCK!!!!!
007 TLNN TT,SY
008 082 029 JRST GET1
009 082 016 JUMPE A,BOUND1
010 HLRZ B,(A) ;MORE CROCK MORE CROCK MORE CROCK!!!!!!
011 HRRZ A,(B) ; (BUT LAP DEPENDS ON IT...)
012 CAIN A,SUNBOUND
013 131 052 SETZ A,
014 POPJ P,
015
016 BOUND1: MOVEI A,VNIL
017 POPJ P,
018
019
020 081 044 GET3: JUMPN A,FALSE
021 MOVEI A,NILPROPS
022 CAIE B,QVALUE
023 082 029 JRST GET1
024 MOVEI A,VNIL
025 POPJ P,
026
027 GET0: HRRZ A,(TT) ;USES ONLY A,B,TT
028 059 031 JUMPE A,CPOPJ
029 GET1: HRRZ TT,(A) ;MUST PRESERVE B, C, AR1, T, D
030 081 044 JUMPE TT,FALSE ;(SEE EVAL AT EV3, MKNAM3, .REARRAY, AND ARRY1)
031 HLRZ A,(TT) ;ALSO PRESERVE R, SEE UUOH1
032 CAIE A,(B) ;ALSO AR2A AND F, SEE FASLOAD
033 082 027 JRST GET0
034 HRRZ TT,(TT)
035 HLRZ A,(TT)
036 POPJ P,
037
038 SARGET: MOVEI TT,(A)
039 005 042 LSH TT,-SEGLOG
040 036 033 MOVE TT,ST(TT)
041 TLNE TT,SA
042 POPJ P,
043 080 013 ARGET: JSP T,SPATOM ;GET ARRAY PROPERTY FROM ATOM
044 JSP T,PNGE1
045 ARGET1: MOVEI B,QARRAY
046 082 029 JRST GET1
047
048 080 013 PNGET: JSP T,SPATOM ;INTERNAL SUBROUTINE -GET PNAME PROP FROM ATOM
049 PNGT1: JSP T,PNGE
050 PNGT0: SKIPN A ;SAVES B
051 039 025 SKIPA TT,[$$$NIL]
052 HLRZ TT,(A) ;MUST DO IT INTO TT SO AS TO HAVE
053 HRRZ A,1(TT) ; CONTINUOUS GC PROTECTION
GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 82.1
054 POPJ P,
055 132 058 .SEE CRSR40
GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 83
001
002 GETLE2: %WTA NASER
003 GETL: SKIPN V.RSET
004 083 013 JRST GETL5
005 SKOTT B,LS
006 JUMPN B,GETLE
007 GETLA: MOVEI TT,(A)
008 005 042 LSH TT,-SEGLOG
009 036 033 MOVE TT,ST(TT)
010 TLNE TT,LS+SY
011 083 020 JRST GETL1
012 083 002 JUMPN A,GETLE2 ;FALL INTO GETL5 - WON'T HURT
013 083 020 GETL5: JUMPN A,GETL1
014 MOVEI A,NILPROPS
015 083 020 JRST GETL1
016
017
018 GETL0: HRRZ A,(A) ;USES A,B,C,T,TT
019 059 031 JUMPE A,CPOPJ
020 GETL1: HRRZ A,(A)
021 059 031 JUMPE A,CPOPJ
022 HLRZ T,(A)
023 035 006 SKIPA C,B
024 035 006 GETL4: HRRZ C,(C)
025 083 018 GETL3: JUMPE C,GETL0
026 035 006 HLRZ TT,(C)
027 CAIE T,(TT)
028 083 024 JRST GETL4
029 POPJ P,
GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 84
001
002 ;;; ARGUMENTS ARE A SYMBOL, A VALUE, AND AN INDICATOR.
003 ;;; THE INDICATOR MUST NOT BE A PDL QUANTITY (RECALL THAT THE
004 ;;; EQNESS OF SUCH QUANTITIES IS UNDEFINED IN THE LANGUAGE ANYWAY).
005 ;;; THE VALUE IS PDLNMK'D IF NECESSARY. THE SYMBOL MAY BE A LIST
006 ;;; (KNOWN AS A "DISEMBODIED PROPERTY LIST"; THE CDR IS THE PLIST).
007 ;;; IF THE PROPERTY ALREADY EXISTS, THE NEW VALUE IS INSTALLED THERE.
008 ;;; OTHERWISE A NEW PROPERTY IS INSTALLED AT THE FRONT OF THE
009 ;;; PROPERTY LIST. IF THE PROPERTY ALREADY EXISTS IN A PORTION
010 ;;; OF THE PROPERTY LIST THAT IS PURE, ENOUGH OF THE PURE PART
011 ;;; IS COPIED AS IMPURE LIST STRUCTURE TO PERMIT THE PUTPROP.
012 ;;; IF THE VALUE OF *PURE IS NON-NIL, THEN THE VALUE IS PURCOPY'D
013 ;;; AND THE NEW PROPERTY LIST CELLS, IF ANY, ARE PURE-CONSED.
014
015 PUTPROP:
016 SKOTT A,LS+SY ;LISTS AND SYMBOLS ARE OKAY
017 084 037 JRST CSET7
018 027 023 CSET0C: CAML B,NPDLL ;MAKE A QUICK TEST ON THE SECOND ARGUMENT
019 027 024 CAML B,NPDLH ;SHIP-OF-THE-DESERT TEST (TWO CAML'S)
020 084 024 JRST CSET0Q
021 EXCH B,A ;LOSE - MUST PDLNMK THE VALUE
022 094 012 JSP T,PDLNMK
023 EXCH B,A
024 CSET0Q: MOVEI T,(A)
025 CSET0: HRRZ T,(T) ;MUST SAVE AR1,R,F FOR FASLOAD - SEE LDENT
026 084 042 JUMPE T,CSET2 ;SEARCH FOR AN EXISTING PROPERTY
027 HLRZ TT,(T)
028 HRRZ T,(T)
029 035 006 CAIE TT,(C)
030 084 025 JRST CSET0
031 CSET0A: ;IF PROPERTY FOUND, CLOBBER IN
032 084 056 PURTRAP CSET4,T, HRLM B,(T)
033 BRETJ:
034 SPROG2: MOVEI A,(B) ;RETURN VALUE
035 POPJ P,
036
037 CSET7: JUMPN A,PROPER
038 MOVEI A,NILPROPS
039 084 018 JRST CSET0C
040
041
042 CSET2: PUSH P,A ;ATOM DOESN'T HAVE SUCH A PROPERTY, SO CONS ONE UP
043 SKIPE V.PURE
044 209 011 JRST CSETP1 ;MAYBE WANT TO PURE-CONS
045 CSET2A: HRRZ A,(A) ;PLAIN VANILLA CONSES
046 073 009 PUSHJ P,XCONS
047 035 006 HRRZ B,C
048 073 009 PUSHJ P,XCONS
049 035 006 POP P,C
050 035 006 HRRM A,(C) ;SETPLIST TO NEW THING
051 $CADR: HRRZ A,(A) ;RETURN VALUE (I.E. GET IT BACK)
052 HLRZ A,(A)
053 POPJ P,
GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 84.1
054
055
056 CSET4: PUSH P,A ;FOOL PROPERTY IS IN A PURE PAGE
057 PUSH P,B
058 MOVEI T,(A)
059 CSET4A: HRRZ TT,(T) ;COPY ENOUGH OF THE PROPERTY LIST
060 085 024 PUSHJ P,CSET4C ; TO PERMIT THE PUTPROP
061 HLRZ A,(TT)
062 035 006 CAIE A,(C)
063 084 059 JRST CSET4A
064 POP P,B
065 POP P,A
066 084 031 JRST CSET0A ;NOW TRY IT
GET, GETL, PUTPROP, REMPROP FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 85
001
002
003 REMPROP: ;SUBR 2 - REMOVE PROPERTY FROM ATOMIC SYMBOL
004 SKOTT A,LS+SY
005 085 019 JRST REMP7 ;MUST SAVE AR1,R,F FOR FASLOAD - SEE LDENT
006 181 046 REMP0: SKIPA D,A ;SAVE C, AR2A - SEE DEFPROP AND DEFUN
007 181 046 REMP1: HRRZ D,(T)
008 181 046 HRRZ T,(D)
009 081 044 JUMPE T,FALSE
010 MOVS TT,(T)
011 CAIE B,(TT)
012 085 007 JRST REMP1
013 HLRZ T,TT
014 REMP20: HRRZ TT,(T) ;A IS GC-PROTECTING THE ATOM
015 085 033 PURTRAP REMP3,D, HRRM TT,(D)
016 MOVEI A,(T)
017 POPJ P,
018
019 REMP7: JUMPN A,RMPER0
020 MOVEI A,NILPROPS
021 085 006 JRST REMP0
022
023
024 CSET4C: PUSHJ P,.+1 ;HAIRY WAY TO DO A DOUBLE COPY!
025 HRRZ A,(T)
026 MOVE B,(A)
027 073 012 PUSHJ P,CONS1
028 HRRM A,(T)
029 MOVEI T,(A)
030 POPJ P,
031
032
033 REMP3: PUSH P,A ;COME HERE ON PURE PAGE TRAP
034 PUSH P,B ;A ON PDL GC PROTECTS ATOM
035 MOVEI T,(A)
036 085 024 REMP3A: PUSHJ P,CSET4C ;COPY ENOUGH OF PROPERTY LIST
037 HRRZ TT,(T) ; TO DO REMPROP
038 HLRZ A,(TT)
039 CAME A,(P)
040 085 036 JRST REMP3A
041 HRRZ A,(TT)
042 HRRZ TT,(A)
043 HRRM TT,(T)
044 059 030 JRST POP2J
045
NOT, NULL, LAST, BOUNDP, RUNTIME LISP.393[MAC,LSP] 01/17/78 Page 86
001
002 SUBTTL NOT, NULL, LAST, BOUNDP, RUNTIME
003
004
005 059 031 NOTNOT: JUMPE A,CPOPJ ;REPLACES A NON-NIL VALUE BY T
006 086 011 JRST TRUE
007
008
009 NOT:
010 081 044 $NULL: JUMPN A,FALSE
011 TRUE: MOVEI A,TRUTH
012 086 009 CNOT: POPJ P,NOT
013
014
015 LAST: SKIPN T,A ;SUBR 1 - GET LAST CONS OF A LIST
016 POPJ P, ;RETURN NIL IF NIL
017 LAST1: HRRZ TT,(T) ;ELSE USE SUPER-FAST LOOP
018 086 022 JUMPE TT,LAST2 ; - ONLY TWO INSTRUCTIONS
019 HRRZ T,(TT) ; PER LIST ELEMENT SKIPPED!
020 086 017 JUMPN T,LAST1
021 SKIPA A,TT
022 LAST2: MOVEI A,(T)
023 POPJ P,
024
025
026 086 011 BOUNDP: JUMPE A,TRUE ;SUBR 1
027 080 013 JSP T,SPATOM ;TRUE IFF THE SYMBOL ARGUMENT IS BOUND
028 JSP T,PNGE1 ;ERROR FOR NON-SYMBOLS
029 HLRZ T,(A) ;GET VALUE CELL
030 HRRZ A,(T) ;DO IT INTO T TO PROTECT FROM GC
031 HRRZ T,(A)
032 CAIN T,QUNBOUND
033 TDZA A,A
034 MOVEI A,TRUTH
035 POPJ P,
036
037 ;;; RETURN RUNTIME AS A FIXNUM IN MICROSECOND
038 ;;; UNITS (NOT NECESSARILY THAT ACCURATE THOUGH).
039
040 064 007 $RUNTIME: PUSH P,CFIX1 ;SUBR 0 NCALLABLE
041 IT$ .SUSET [.RRUNT,,TT] ;RUNTIME IN 4-MICROSECOND UNITS
042 131 052 10$ SETZ TT,
043 10$ RUNTIM TT, ;RUNTIME IN MILLISECONDS
044 005 006 IFN D20,[
045 LOCKI ;MUST LOCKI OVER ALL JSYS'S
046 MOVEI 1,.FHSLF ;GET RUNTIME FOR SELF
047 RUNTM
048 MOVE TT,1 ;RUNTIME IN MILLISECONDS
049 SETZB 1,3 ;1 AND 3 HAVE DANGEROUS CRUD
050 UNLOCKI
051 ] ;END OF IFN D20
052 RNTM1: ;CONVERT NUMBER FROM INTERNAL UNITS TO USECS
053 IT$ LSH TT,2
NOT, NULL, LAST, BOUNDP, RUNTIME LISP.393[MAC,LSP] 01/17/78 Page 86.1
054 IT% IMULI TT,1000.
055 POPJ P, ;ANSWER IN MICROSECONDS
TIME FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 87
001
002 SUBTTL TIME FUNCTION
003
004 ;;; RETURN A TIME STANDARD AS A FLONUM IN SECONDS.
005 ;;; WE ENDEAVOR TO MAKE THIS INCREASE MONOTONICALLY AND TO MEASURE
006 ;;; THE PASSAGE OF REAL TIME. IN PRACTICE, WE MAY NOT MEASURE
007 ;;; REAL TIME WHILE THE TIME-SHARING SYSTEM IS TEMPORARILY STOPPED,
008 ;;; AND WE PERMIT A GLITCH (RESET TO 0) AT MIDNIGHT OF EACH DECEMBER 31.
009
010 064 008 TIME: PUSH P,CFLOAT1 ;SUBR 0 NCALLABLE
011 002 026 IFN ITS,[
012 .RDTIME TT, ;GET AMOUNT OF TIME SYSTEM HAS BEEN UP
013 ; CAMGE TT,[30.*3600.*24.*28.] ;FOUR WEEKS OF 1/30 SEC TICS
014 ; JRST .+3
015 ; SUB TT,[30.*3600.*24.*28.]
016 ; JRST .-3
017 064 031 JSP T,IFLOAT
018 FDVRI TT,(30.0)
019 ] ;END OF IFN ITS
020 005 005 IFN D10,[
021 002 029 IFE SAIL,[
022 MOVE T,[%CNDTM] ;INTERNAL DATE/TIME STANDARD,
023 GETTAB T, ; AS DATE,,FRACTION OF DAY
024 087 031 JRST TIME3 ; 1-ORIGINED ON NOVEMBER 18, 1858
025 ADD T,[2*365.+1-43.,,] ;ALTER TO 0-ORIGIN ON JANUARY 1,1856
026 IDIV T,[365.*4+1,,] ;GET THIS MOD A FOUR-YEAR INTERVAL
027 064 031 JSP T,IFLOAT
028 FMPR T,[.OP <FSC -22>,86400.0,0] ;CONVERT TO SECONDS
029 POPJ P,
030
031 TIME3: MSTIME TT, ;THIS PRODUCES GLITCHES AT MIDNIGHT
032 064 031 JSP T,IFLOAT
033 FDVRI TT,(1000.0)
034 ] ;END OF IFE SAIL
035 002 029 IFN SAIL,[
036 ACCTIM TT,
037 181 046 HLRZ D,TT
038 181 046 IDIVI D,12.*31. ;YEAR-1964 IN D
039 071 024 IDIVI R,31. ;MONTH-1 IN R, DAY-1 IN F
040 087 062 ADD F,TIME8(R) ;ADD IN NUMBER OF DAYS PRECEDING CURRENT MONTH
041 181 046 TLNN D,3 ;SKIP IF NOT LEAP YEAR
042 071 024 CAIL R,2 ;SKIP IF JANUARY OR FEBRUARY
043 SUBI F,1 ;ADJUST FOR CRETINOUS LEAP YEARS
044 IMULI F,24.*3600. ;CONVERT TO SECONDS FROM LAST MIDNIGHT TO MIDNIGHT LAST DEC 31
045 TLZ TT,-1
046 ADD TT,F ;ADD IN SECONDS SINCE MIDNIGHT LAST
047 064 031 JSP T,IFLOAT
048 ] ;END OF IFN SAIL
049 ] ;END OF IFN D10
050 005 006 IFN D20,[
051 LOCKI ;MUST LOCKI AROUND THE JSYS
052 087 010 TIME ;GET TIME SINCE SYSTEM LAST RESTARTED IN MILLISECONDS
053 MOVE TT,2
TIME FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 87.1
054 131 052 SETZ 1, ;ZERO CRUD
055 UNLOCKI
056 064 031 JSP T,IFLOAT
057 FDVRI TT,(1000.0) ;CONVERT TO SECONDS
058 ] ;END OF IFN D20
059 POPJ P,
060
061 002 029 IFN SAIL,[
062 TIME8:
063 ZZZ==1 ;WILL SUBTRACT THIS 1 BACK EXCEPT FOR AFTER FEB 29'S
064 IRP X,,[31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.]
065 004 063 ZZZ
066 004 063 ZZZ==ZZZ+X
067 TERMIN
068 004 063 IFN ZZZ-366., WARN [TABLE OF CUMULATIVE DAYS IN MONTHS LOSES]
069 004 063 EXPUNGE ZZZ
070 ] ;END OF IFN SAIL
EQUAL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 88
001
002 SUBTTL EQUAL FUNCTION
003
004 EQUAL: CAIN A,(B) ;EQ THINGS ARE EQUAL
005 086 011 JRST TRUE
006 020 064 MOVEM P,EQLP
007 088 012 PUSHJ P,EQUAL1 ;EQUAL1 ACTUALLY RETURNS ONLY IF EQUAL
008 086 011 JRST TRUE
009
010 EQUAL0: CAIN A,(B) ;EQ THINGS ARE EQUAL
011 POPJ P,
012 EQUAL1: MOVEI T,(A)
013 MOVEI TT,(B)
014 005 042 ROTC T,-SEGLOG ;GET TYPES OF ARGS
015 036 033 HRRZ T,ST(T)
016 036 033 MOVE TT,ST(TT)
017 CAIN T,(TT) ;MUST HAVE SAME TYPE TO BE EQUAL
018 036 038 2DIF JRST @(T),EQLTBL,QLIST .SEE STDISP
019 002 050 IFN HNKLOG,[
020 SKIPN VHUNKP
021 TLNN TT,LS
022 ] ;END OF IFN HNKLOG
023 088 068 JRST EQLOSE
024 002 050 IFN HNKLOG,[
025 SKOTT A,LS ;IF VHUNKP CONTAINS NIL, THEN WANT TO
026 088 068 JRST EQLOSE ; TREAT ALL HUNKS AS IF THEY WERE LIST CELLS
027 ] ;END OF IFN HNKLOG
028 EQLLST: PUSH P,(A)
029 PUSH P,(B)
030 HLRZ A,(A)
031 HLRZ B,(B)
032 088 010 PUSHJ P,EQUAL0 ;COMPARE CARS
033 HRRZ A,-1(P)
034 HRRZ B,0(P)
035 064 009 SUB P,R70+2
036 088 010 JRST EQUAL0 ;COMPARE CDRS
037
038 088 028 EQLTBL: EQLLST ;LIST
039 088 065 EQLNUM ;FIXNUM
040 088 065 EQLNUM ;FLONUM
041 088 061 DB$ EQLNM2 ;DOUBLE
042 088 061 CX$ EQLNM2 ;COMPLEX
043 088 052 DX$ EQLNM4 ;DUPLEX
044 088 072 BG$ EQLBIG ;BIGNUM
045 088 068 EQLOSE ;PNAME ATOMS MUST BE EQ TO BE EQUAL
046 088 082 REPEAT HNKLOG, EQLHNK ;HUNKS REQUIRE RECURSION LIKE LISTS
047 088 068 EQLOSE ;RANDOMS AND NIL MUST BE EQ TO BE EQUAL
048 088 068 EQLOSE ;ARRAY POINTERS MUST BE EQ TO BE EQUAL
049 088 038 IFN .-EQLTBL-NTYPES, WARN [WRONG LENGTH TABLE]
050
051 005 046 IFN DXFLAG,[
052 EQLNM4:
053 KA MOVE T,2(A)
EQUAL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 88.1
054 KA MOVE TT,3(A)
055 KIKL DMOVE T,2(A)
056 CAMN T,2(B)
057 CAME TT,3(B)
058 088 068 JRST EQLOSE
059 ] ;END OF IFN DXFLAG
060 002 069 IFN DBFLAG+CXFLAG,[
061 EQLNM2: MOVE T,1(A)
062 CAME T,1(B)
063 088 068 JRST EQLOSE
064 ] ;END OF IFN DBFLAG+CXFLAG
065 EQLNUM: MOVE T,(A)
066 CAMN T,(B) ;COMPARE VALUES OF NUMBERS
067 POPJ P,
068 020 064 EQLOSE: MOVE P,EQLP ;THE ULTIMATE FALSITY - ESCAPE BACK
069 081 044 JRST FALSE ; TO TOP LEVEL OF ENTRY TO EQUAL WITH FALSE
070
071 002 041 IFN BIGNUM,[
072 EQLBIG: HLRZ T,(A)
073 HLRZ TT,(B)
074 CAIE T,(TT) ;EQUAL BIGNUMS HAVE EQ SIGNS
075 088 068 JRST EQLOSE ; AND CDRS ARE EQUAL LISTS OF FIXNUMS
076 HRRZ A,(A) ;CHECK ONLY EQUAL CDRS
077 HRRZ B,(B)
078 088 010 JRST EQUAL0
079 ] ;END OF IFN BIGNUM
080
081 002 050 IFN HNKLOG,[
082 EQLHNK: SKIPN VHUNKP
083 088 028 JRST EQLLST
084 PUSH P,A
085 PUSH P,B
086 MOVNI T,2
087 2DIF [LSH T,(TT)]0,QHUNK1 ;REALLY SHOULD BE ASH, BUT LSH IS FASTER ON KL10
088 HRLI B,(T)
089 PUSH P,A
090 PUSH P,B
091 EQLHN1: HLRZ A,@-1(P)
092 HRRZ B,(P)
093 HLRZ B,(B)
094 088 010 PUSHJ P,EQUAL0
095 HRRZ A,@-1(P)
096 HRRZ B,(P)
097 HRRZ B,(B)
098 088 010 PUSHJ P,EQUAL0
099 MOVE T,(P)
100 088 105 AOBJP T,EQLHN2
101 MOVEM T,(P)
102 AOS -1(P)
103 088 091 JRST EQLHN1
104
105 064 009 EQLHN2: SUB P,R70+4
106 POPJ P,
EQUAL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 88.2
107 ] ;END OF IFN HNKLOG
NCONC, *NCONC, APPEND, *APPEND, REVERSE, NREVERSE, NRECONC LISP.393[MAC,LSP] 01/17/78 Page 89
001
002 SUBTTL NCONC, *NCONC, APPEND, *APPEND, REVERSE, NREVERSE, NRECONC
003
004 071 024 NCONC: TDZA R,R ;LSUBR - DESTRUCTIVELY CATENATE LISTS
005 089 015 APPEND: MOVEI R,.APPEND-.NCONC ;LSUBR - CATENATE BY COPYING
006 081 044 JUMPE T,FALSE
007 POP P,B
008 084 033 APP2: AOJE T,BRETJ
009 POP P,A
010 089 015 PUSHJ P,.NCONC(R)
011 MOVE B,A
012 089 008 JRST APP2
013
014
015 084 033 .NCONC: JUMPE A,BRETJ ;SUBR 2 (*NCONC)
016 SKOTT A,LS
017 209 011 JRST NCNCER
018 .NCNC1: MOVEI TT,(A)
019 181 046 .NCNC2: HRRZ D,(TT)
020 089 026 JUMPE D,.NCNC3
021 181 046 HRRZ TT,(D)
022 089 019 JUMPN TT,.NCNC2
023 181 046 HRRM B,(D)
024 POPJ P,
025
026 .NCNC3: HRRM B,(TT)
027 POPJ P,
028
029
030 084 033 .APPEND: JUMPE A,BRETJ ;SUBR 2 (*APPEND)
031 SKOTT A,LS
032 209 011 JRST APPERR
033 035 006 MOVEI C,AR1 ;MUST SAVE T,D - SEE MAKOBLIST
034 MOVE AR2A,A
035 APP1: HLRZ A,(AR2A)
036 073 010 PUSHJ P,CONS
037 HRRZ B,(A)
038 035 006 HRRM A,(C)
039 035 006 MOVE C,A
040 HRRZ AR2A,(AR2A)
041 089 035 JUMPN AR2A,APP1
042 AR1RETJ:
043 SUBS4: MOVEI A,(AR1)
044 POPJ P,
045
046
047 035 006 REVERSE: MOVEI C,(A) ;SUBR 1 - USES A,B,C
048 MOVEI A,NIL ;REVERSES A LIST BY CONSING UP A COPY
049 059 031 REV1: JUMPE C,CPOPJ ; OF THE TOP LEVEL IN REVERSE ORDER
050 035 006 HLRZ B,(C)
051 073 009 PUSHJ P,XCONS
052 035 006 HRRZ C,(C)
053 089 049 JRST REV1
NCONC, *NCONC, APPEND, *APPEND, REVERSE, NREVERSE, NRECONC LISP.393[MAC,LSP] 01/17/78 Page 89.1
054
055 131 052 NREVERSE: SETZ B, ;SUBR 1 - REVERSE A LIST USING RPLACD'S
056 084 033 NRECONC: JUMPE A,BRETJ ;SUBR 2 - (NRECONC X Y) = (NCONC (NREVERSE X) Y)
057 035 006 NREV1: HRRZ C,(A) ;ONLY 3 INSTRUCTIONS PER CELL! ZOOM!
058 HRRM B,(A)
059 059 031 JUMPE C,CPOPJ
060 035 006 HRRZ B,(C)
061 035 006 HRRM A,(C)
062 091 050 JUMPE B,CRETJ
063 HRRZ A,(B)
064 035 006 HRRM C,(B)
065 089 057 JUMPN A,NREV1
066 084 033 JRST BRETJ
067
GENSYM FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 90
001
002 SUBTTL GENSYM FUNCTION
003
004 090 021 GENSYM: JUMPN T,GENSY1
005 030 052 GENSY0: MOVE TT,[010700,,GNUM] ;STANDARD GENSYMER
006 GENSY4: MOVEI B,"0 ;WILL INCREMENT NUMERICAL PART
007 GENSY2: LDB T,TT ; AND GIVE OUT GENSYMED ATOM
008 AOS T
009 DPB T,TT
010 CAIG T,"9
011 090 016 JRST GENSY3
012 DPB B,TT
013 ADD TT,[070000,,0]
014 CAMGE TT,[350000,,]
015 090 007 JRST GENSY2
016 030 052 GENSY3: MOVE TT,GNUM
017 022 019 MOVEM TT,PNBUF
018 022 019 MOVEI C,PNBUF
019 072 012 JRST PNGNK2
020
021 181 046 GENSY1: MOVEI D,QGENSYM
022 AOJN T,S1WNALOSE
023 GENSY7: POP P,A
024 SKOTT A,FX
025 090 037 JRST GENSY5
026 MOVE TT,(A)
027 JUMPL TT,GENSY8
028 030 052 MOVE T,[010700,,GNUM]
029 GENSY6: IDIVI TT,10. ;INSTALL 4 DECIMAL DIGITS
030 181 046 ADDI D,"0 ; IN GENSYM COUNTER
031 181 046 DPB D,T
032 ADD T,[070000,,0]
033 CAMGE T,[350000,,]
034 090 029 JRST GENSY6
035 090 016 JRST GENSY3
036
037 GENSY5: TLNN TT,SY
038 JUMPN A,GENSY8
039 107 054 JSP T,CHNV1D
040 030 052 DPB TT,[350700,,GNUM]
041 090 006 JRST GENSY4
MEMBER, MEMQ, SUBST, DELQ, DELETE, *DELQ, *DELETE LISP.393[MAC,LSP] 01/17/78 Page 91
001
002 SUBTTL MEMBER, MEMQ, SUBST, DELQ, DELETE, *DELQ, *DELETE
003
004 021 008 MEMBER: SETZM MEMV ;USES A,B,AR1,AR2A,T,TT
005 MOVEI AR1,(A)
006 MOVEI AR2A,(B)
007 080 012 JSP T,LATOM
008 091 019 JRST MEMB1
009 021 008 SMEMQ: SETZM MEMV ;USES A,B,T,MUST PRESERVE AR1,AR2A;SEE GTSPC3
010 MEMQ2: SKOTT B,LS
011 081 044 JRST FALSE
012 HLRZ T,(B)
013 CAMN A,T
014 084 034 JRST SPROG2
015 021 008 HRRM B,MEMV
016 HRRZ B,(B)
017 091 010 JRST MEMQ2
018
019 MEMB1: SKOTT AR2A,LS
020 081 044 JRST FALSE
021 MOVE A,AR1
022 HLRZ B,(AR2A)
023 088 004 PUSHJ P,EQUAL
024 091 029 JUMPN A,MEMB2 ;TRUE
025 021 008 HRRM AR2A,MEMV
026 HRRZ AR2A,(AR2A)
027 091 019 JRST MEMB1
028 AR2ARETJ:
029 MEMB2: MOVEI A,(AR2A)
030 POPJ P,
031
032 ;;; SUBSTITUTE A FOR EQUAL OCCURRENCES OF B IN C.
033
034 094 012 SUBST: JSP T,PDLNMK ;SUBR 3
035 035 006 EXCH A,C
036 094 012 JSP T,PDLNMK
037 035 006 EXCH A,C
038 SKIPA AR1,A
039 SUBS0A: SKIPA A,AR1
040 SKIPA AR2A,B
041 MOVE B,AR2A
042 035 006 PUSH P,C
043 035 006 MOVE A,C
044 088 004 PUSHJ P,EQUAL
045 035 006 POP P,C
046 089 042 JUMPN A,AR1RETJ
047 035 006 SUBS1: MOVE A,C
048 080 005 PUSHJ P,ATOM
049 091 053 JUMPE A,SUBS2
050 CRETJ:
051 035 006 SPROG3: MOVE A,C
052 POPJ P,
053 035 006 SUBS2: PUSH P,C
MEMBER, MEMQ, SUBST, DELQ, DELETE, *DELQ, *DELETE LISP.393[MAC,LSP] 01/17/78 Page 91.1
054 035 006 HLRZ C,(C)
055 091 039 PUSHJ P,SUBS0A
056 EXCH A,(P)
057 035 006 HRRZ C,(A)
058 091 039 PUSHJ P,SUBS0A
059 SUBS3: POP P,B
060 073 009 JRST XCONS
MEMBER, MEMQ, SUBST, DELQ, DELETE, *DELQ, *DELETE LISP.393[MAC,LSP] 01/17/78 Page 92
001
002 091 009 DELQ: SKIPA D,[SMEMQ] ;USES A,B,C,T,TT. MUST SAVE AR2A - SSMACRO
003 091 004 DELETE: MOVEI D,MEMBER ;USES A,B,C,AR1,AR2A,T,TT
004 MOVEI TT,-1 ;MUST SAVE R, SEE GCP6H1
005 064 014 CAMN T,XC-2
006 092 013 JRST DLT3
007 064 014 CAME T,XC-3
008 209 011 JRST DLT6
009 POP P,A
010 062 010 JSP T,FLTSKP
011 209 011 JRST .+2
012 064 022 JSP T,IFIX
013 021 015 DLT3: MOVEM TT,DLTC
014 MOVEI TT,(P)
015 SKIPA B,(P)
016 DLT2: HRRM B,(TT)
017 021 020 MOVEM TT,TABLU1
018 MOVE A,-1(P)
019 021 015 SOSGE DLTC
020 092 028 JRST DLT1
021 181 046 PUSHJ P,(D) ;MEMBER OR MEMQ
022 092 028 JUMPE A,DLT1
023 HRRZ B,(A)
024 021 008 SKIPN TT,MEMV
025 021 020 MOVE TT,TABLU1
026 092 016 JRST DLT2
027
028 DLT1: POP P,A
029 059 040 JRST POP1J
030
031 091 009 .DELQ: SKIPA D,[SMEMQ]
032 091 004 .DELETE: MOVEI D,MEMBER
033 PUSH P,A
034 PUSH P,B
035 MOVEI TT,-1
036 092 013 JRST DLT3
037
038 081 044 MEMQ: JUMPE B,FALSE
039 HLRZ T,(B)
040 CAIN T,(A)
041 084 033 JRST BRETJ
042 HRRZ B,(B)
043 092 038 JRST MEMQ
044
FLOATP, FIXP, NUMBERP, TYPEP, AND PDLNMK ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 93
001
002 SUBTTL FLOATP, FIXP, NUMBERP, TYPEP, AND PDLNMK ROUTINE
003
004 093 005 IRP NUMP,,[FIXP,FLOATP,NUMBERP]BITS,,[FX+BN,FL,FX+FL+BN]
005 NUMP: SKOTT A,BITS
006 081 044 JRST FALSE ;RETURN NIL IF NOT OF DESIRED TYPE
007 MOVE TT,(A) ;RETURN T IF WHAT WE WANT. ALSO, TT GETS THE NUMBER.
008 086 011 JRST TRUE ;IF NUMBERP GETS A BIGNUM, TT GETS THE CORRECT SIGN, ANYWAY
009 TERMIN
010
011 093 015 TYPEP: JUMPE A,TYPNIL ;SUBR 1 - USES ONLY A
012 005 042 ROT A,-SEGLOG
013 036 033 HRRZ A,ST(A)
014 POPJ P,
015 TYPNIL: MOVEI A,QSYMBOL
016 POPJ P,
017
018 %SYMBOLP: ;SUBR 1
019 080 013 JSP T,SPATOM
020 081 044 JRST FALSE
021 086 011 JRST TRUE
FLOATP, FIXP, NUMBERP, TYPEP, AND PDLNMK ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 94
001
002 NMCK0: POP P,A
003 NUMCHK: ;CHECK TO SEE THAT WE HAVE A NUMBER, THEN EXIT
004 002 070 IFE NARITH,[
005 062 010 BG% JSP T,FLTSKP
006 062 041 BG$ JSP T,NVSKIP
007 BG$ POPJ P,
008 JFCL ;FALLS INTO PDLNKJ
009 ] ;END OF IFE NARITH
010 094 012 IFN NARITH, WARN [NUMCHK? PDLNMK?]
011 059 031 PDLNKJ: MOVEI T,CPOPJ ;PDLNKJ = PDLNMK, THEN POPJ P,
012 027 023 PDLNMK: CAML A,NPDLL ;FIRST A QUICK AND DIRTY CHECK
013 027 024 CAMLE A,NPDLH
014 209 011 JRST (T)
015 005 042 ROT A,-SEGLOG ;NOW TO CHECK THE ST ENTRY
016 226 009 SPECPRO INTROT
017 036 033 HLL T,ST(A)
018 005 042 ROT A,SEGLOG
019 NOPRO
020 TLNN T,$PDLNM ;SKIP IFF PDL NUMBER
021 209 011 JRST (T)
022 PUSH P,T
023 020 052 NMK1: MOVEM TT,PNMK1 ;EXPECTS TYPE BITS IN T
024 MOVE TT,(A)
025 094 030 HRRI T,PNMK2 ;MUST SAVE TT
026 TLNN T,FL ;FIGURE OUT WHICH KIND OF CONS TO DO
027 074 007 JRST FXCONS ; - FIXNUM
028 074 030 JRST FLCONS ; - FLONUM
029
030 020 052 PNMK2: MOVE TT,PNMK1 ;RESTORE TT FOR PDLNMK
031 094 011 CPDLNKJ: POPJ P,PDLNKJ
GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 95
001
002 SUBTTL GCPRO AND SXHASH
003
004 096 008 GCPRO: JUMPE B,GCREL
005 CAIN B,QM ;SECOND ARG = ? MEANS ONLY GCLOOK
006 096 009 JRST GCLOOK
007 %GCPRO: MOVEI AR1,1 ;MUST SAVE R,F - FOR FASLOAD
008 GCPR1: CAIL A,IN0-XLONUM
009 CAILE A,IN0+XHINUM-1
010 209 011 JRST .+2
011 POPJ P,
012 SKOTT A,SY
013 095 021 JRST GCPR2
014 059 031 JUMPLE AR1,CPOPJ
015 HLRZ T,(A)
016 MOVSI TT,100 ;COMPILED CODE NEEDS ME BIT
017 181 046 MOVSI D,200 ;PURE SYMBOL BLOCK BIT
018 181 046 TDNN D,(T)
019 IORM TT,(T)
020 POPJ P,
021 GCPR2: MOVE AR2A,A ;SAVE ARG
022 097 021 PUSHJ P,SXHSH0 ;LEAVES HASHKEY IN D
023 MOVE A,AR2A
024 MOVE T,AR1 ;T=0 => RELEASE, ELSE PROTECT
025 059 031 .GCPRO: JUMPE A,CPOPJ
026 LOCKI
027 PUSH P,A ;PLACES ORIG ARG ON PDL
028 060 036 PUSHJ P,SAVX5 ;SAVES NUM ACS
029 SKIPE B,GCPSAR
030 095 038 JRST .GCPR5
031 MOVEI A,NIL
032 032 024 MOVE TT,LOSEF
033 ADDI TT,1
034 LSH TT,-1
035 PUSHJ P,MKLSAR
036 181 046 MOVE D,-2(FXP) ;RESTORE HASHKEY IN D
037 MOVEM B,GCPSAR
038 181 046 .GCPR5: MOVE T,D ;ARG ON P, AND SAVES NUM ACS ON FXP
039 LSH T,-1
040 032 024 IDIV T,LOSEF
041 PUSH FXP,TT
042 MOVEI A,(FXP)
043 PUSHJ P,@ASAR(B)
044 064 009 SUB FXP,R70+1
045 071 024 MOVEM R,-3(FXP)
046 MOVE B,A
047 MOVE A,(P) ;ORIG ARG ON P
048 PUSH P,B ;SAVE PROLIST BUCKET
049 SKIPN -4(FXP)
050 096 002 JRST GCRL1 ;GO RELEASE IF FLAG SO SET.
051 091 004 PUSHJ P,MEMBER
052 095 061 JUMPN A,GCPR3 ;ITEM ALREADY IN PROTECTIVE BUCKET
053 SKIPG -4(FXP)
GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 95.1
054 095 062 JRST GCPR4
055 MOVE A,-1(P) ;ORIGINAL ARG
056 MOVE B,(P) ;CONSED ONTO PROLIST BUKET
057 073 010 PUSHJ P,CONS
058 MOVE R,-3(FXP)
059 181 046 HRRZ D,GCPSAR
060 056 014 JSP T,.STOR0
061 GCPR3: HLRZ A,(A)
062 060 046 GCPR4: PUSHJ P,RSTX5
063 064 009 SUB P,R70+2
064 UNLKPOPJ
GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 96
001
002 GCRL1: CALLF 2,QDELETE ;GCRELEASE
003 071 024 MOVE R,-3(FXP)
004 181 046 HRRZ D,GCPSAR
005 056 014 JSP T,.STOR0
006 095 062 JRST GCPR4
007
008 GCREL: TDZA AR1,AR1
009 GCLOOK: MOVNI AR1,1
010 SKIPN GCPSAR
011 081 044 JRST FALSE
012 095 008 JRST GCPR1
GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 97
001
002 064 007 SXHASH: PUSH P,CFIX1 ;SUBR 1 - NCALLABLE
003 097 021 PUSHJ P,SXHSH0 ;SAVE F - SEE DEFUN
004 181 046 MOVE TT,D
005 POPJ P,
006
007 ATMHSH: ;HASH A PRINT NAME
008 131 052 BNHSH: SETZ T, ;HASH A BIGNUM (SAME ALGORITHM)
009 SKIPA B,A
010 AHSH1: HRRZ B,(B)
011 097 015 JUMPE B,AHSH2
012 035 006 HLRZ C,(B)
013 035 006 XOR T,(C)
014 097 010 JRST AHSH1
015 AHSH2: LSH T,-1 ;FOR ATOMS, THIS INSURES THAT THE HASHKEY IS POSITIVE
016 209 011 JRST (TT)
017
018 181 046 NILHSH: MOVE D,[<ASCII \NIL\>←-1] ;HASH NIL FASTLY
019 POPJ P,
020
021 097 018 SXHSH0: JUMPE A,NILHSH ;RETURNS S-EXPR'S HASHKEY IN D
022 SKOTT A,LS
023 036 038 2DIF JRST @(TT),SXHSH9-1,QLIST .SEE STDISP
024 HRRZ B,(A)
025 PUSH P,B
026 HLRZ A,(A)
027 097 021 PUSHJ P,SXHSH0
028 181 046 ROT D,-1
029 181 046 PUSH FXP,D
030 POP P,A
031 097 021 PUSHJ P,SXHSH0
032 POP FXP,T
033 181 046 ADD D,T
034 POPJ P,
035
GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 98
001
002 181 046 SXHSH8: MOVM D,(A) ;FLONUM
003 POPJ P,
004
005 181 046 SXHSH7: MOVE D,(A) ;FIXNUM
006 POPJ P,
007
008 002 041 IFN BIGNUM,[
009 SXHSH4: HRRZ A,(A) ;BIGNUM
010 097 008 JSP TT,BNHSH
011 181 046 MOVE D,T
012 POPJ P,
013 ] ;END OF IFN BIGNUM
014
015
016 SXHSH5: HLRZ T,(A) ;SYMBOL
017 HRRZ A,1(T)
018 097 007 JSP TT,ATMHSH
019 181 046 SKIPA D,T
020 181 046 SXHSH6: MOVEI D,(A)
021 POPJ P, ;RANDOM, ARRAY
022
023
024 098 005 SXHSH9: SXHSH7 ;FIXNUM
025 098 002 SXHSH8 ;FLONUM
026 098 038 DB$ SXHSD1 ;DOUBLE
027 098 047 CX$ SXHSC1 ;COMPLEX
028 098 052 DX$ SXHSZ1 ;DUPLEX
029 098 009 BG$ SXHSH4 ;BIGNUM
030 098 016 SXHSH5 ;SYMBOL
031 098 063 REPEAT HNKLOG, SXHS1A ;HUNKS
032 098 020 SXHSH6 ;RANDOM
033 098 020 SXHSH6 ;ARRAY
034 098 024 IFN .-SXHSH9-NTYPES+1, WARN [WRONG LENGTH TABLE]
035
036
037 002 068 IFN DBFLAG,[
038 181 046 SXHSD1: MOVE D,1(A)
039 181 046 KA ASH D,10
040 ] ;END OF IFN DBFLAG
041 002 069 IFN DBFLAG+CXFLAG,[
042 181 046 SXHSD2: ADD D,(A)
043 POPJ P,
044 ] ;END OF IFN DBFLAG+CXFLAG
045
046 002 069 IFN CXFLAG,[
047 181 046 SXHSC1: MOVS D,1(A)
048 098 042 JRST SXHSD2
049 ] ;END OF IFN CXFLAG
050
051 005 046 IFN DXFLAG,[
052 181 046 SXHSZ1: MOVE D,3(A)
053 181 046 KA ASH D,10
GCPRO AND SXHASH LISP.393[MAC,LSP] 01/17/78 Page 98.1
054 181 046 SUB D,2(A)
055 KA MOVE T,1(A)
056 KA ASH T,10
057 181 046 KA XOR D,T
058 181 046 KIKL XOR D,1(A)
059 098 042 JRST SXHSD2
060 ] ;END OF IFN DXFLAG
061
062 002 050 IFN HNKLOG,[
063 SXHS1A: MOVSI T,-2
064 2DIF [LSH T,(TT)]0,QHUNK1
065 PUSH P,A
066 HRRI T,(A)
067 PUSH P,T
068 064 009 PUSH FXP,R70
069 SXHS1B: HLRZ A,(T)
070 097 021 PUSHJ P,SXHSH0
071 181 046 ROT D,1
072 181 046 ADDM D,(FXP)
073 MOVE T,(P)
074 HRRZ A,(T)
075 097 021 PUSHJ P,SXHSH0
076 181 046 ADD D,(FXP)
077 181 046 ROT D,2
078 181 046 MOVEM D,(FXP)
079 MOVE T,(P)
080 098 084 AOBJP T,SXHS1F
081 MOVEM T,(P)
082 098 069 JRST SXHS1B
083
084 064 009 SXHS1F: SUB P,R70+2
085 059 057 JRST POPXDJ
086 ] ;END OF IFN HNKLOG
087
MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 99
001
002 SUBTTL MAPPING FUNCTIONS
003
004 ;;; MAPATOMS FUNCTION
005 ;;; (MAPATOMS FN) CALLS FN REPEATEDLY, FEEDING IT SUCCESSIVE
006 ;;; ATOMS FROM THE CURRENT OBARRAY. OPTIONAL SECOND ARG
007 ;;; SPECIFIES OBARRAY (MUST BE A SAR!). RETURNS NIL.
008
009 MAPATOMS:
010 181 046 MOVEI D,QMAPATOMS
011 AOJG T,S1WNALOSE
012 AOJL T,S2WNALOSE
013 SKIPE T ;SECOND ARG DEFAULTS TO
014 PUSH P,VOBARRAY ; CURRENT OBARRAY
015 205 008 MOVEI TT,(CALL 1,)
016 HRLM TT,-1(P)
017 064 009 PUSH P,R70
018 002 044 PUSH FXP,[OBTSIZ] ;NUMBER OF BUCKETS
019 MAPAT1: SOSGE TT,(FXP) ;TT GETS BUCKET NUMBER
020 099 035 JRST MAPAT9
021 HRRZ AR1,-1(P)
022 ROT TT,-1
023 HLRZ A,@TTSAR(AR1) ;FETCH BUCKET
024 SKIPGE TT
025 HRRZ A,@TTSAR(AR1)
026 MOVEM A,(P) ;SAVE BUCKET
027 MAPAT2: SKIPN B,(P) ;MAPCAR DOWN BUCKET
028 099 019 JRST MAPAT1
029 HLRZ A,(B)
030 HRRZ B,(B)
031 MOVEM B,(P)
032 209 025 XCT -2(P) ;CALL SUPPLIED FUNCTION
033 099 027 JRST MAPAT2
034
035 064 009 MAPAT9: SUB FXP,R70+1 ;EXIT, RETURNING NIL
036 064 009 SUB P,R70+3
037 081 044 JRST FALSE
MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 100
001
002 ;;; PDL STRUCTURE FOR MAP SERIES
003 ;;; ,,RETURN ;LEFT HALF MAY HAVE BAKTRACE INFO
004 ;;; ,,EVENTUAL VALUE ;LEFT HALF HAS LAST OF VALUE LIST
005 ;;; LIST1 ;SECOND ARG
006 ;;; LIST2 ;THIRD ARG
007 ;;; LIST3 ;FOURTH ARG
008 ;;; ...
009 ;;; LISTN ;LAST ARG
010 ;;; -N,,<ADDRESS OF LIST1 ON STACK>
011 ;;; CODE,,MODE ;CODE TELLS WHAT KIND OF MAP, MODE TELLS HOW TO CALL FN
012 ;;; ; (MODE IS ADDRESS OF PLACE WHICH SETS UP ARGS FOR FN)
013 ;;; MAPL6 ;OR MAYBE MAPL3 - THIS IS WHERE FN CALL RETURNS TO
014 ;;; JCALL K,FN ;FN=FIRST ARG - K=1,2,3,4,5, OR 16
015 ;;; ;UUO HANDLER MAY CLOBBER THIS WITH A JRST
016 ;;; ;IF NEVER GOING TO BE XCT'ED, JCALL NEED NOT BE THERE
017
018 100 024 MAPLIST: JSP TT,MAPL0 ;CODE 0
019 100 024 MAPCAR: JSP TT,MAPL0 ;CODE 1
020 100 024 MAP: JSP TT,MAPL0 ;CODE 2
021 100 024 MAPC: JSP TT,MAPL0 ;CODE 3
022 100 024 MAPCON: JSP TT,MAPL0 ;CODE 4
023 100 024 $MAPCAN: JSP TT,MAPL0 ;CODE 5
024 MAPL0: AOJGE T,MAPWNA ;LOSE IF ONLY ONE ARG
025 181 046 MOVE D,T
026 181 046 ADDI D,1(P) ;D HAS ADDRESS OF LIST1 ON STACK
027 181 046 HRLI D,(T)
028 181 046 PUSH P,D
029 100 018 10$ SUBI TT,MAPLIST ;LOSING D10 DISALLOWS
030 10$ MOVSI TT,-1(TT) ; NEGATIVE RELOCATION
031 100 018 .ELSE MOVSI TT,-MAPLIST-1(TT) ;FIGURE OUT CODE FOR WHICH KIND OF MAP
032 PUSH P,TT ;SAVE CODE - FIGURE OUT MODE LATER
033 TLNE TT,2 ;SKIP IF WE'LL BE SAVING UP RESULTS
034 181 046 SKIPA A,(D) ;ELSE WE'LL JUST RETURN FIRST LIST AS VALUE
035 181 046 MOVSI A,-1(D)
036 181 046 EXCH A,-1(D) ;INIT EVENTUAL VALUE SLOT - A NOW HAS FIRST ARG (FN)
037 080 013 JSP T,SPATOM
038 102 002 JRST MAPL5 ;FOOEY, IT'S NOT A SYMBOL
039 035 006 HRRZ C,(A)
040 102 002 MAPL1: JUMPE C,MAPL5 ;FOOEY, IT'S A SYMBOL WITH NO FUNCTION PROPERTY
041 035 006 HLRZ B,(C)
042 035 006 HRRZ C,(C)
043 035 006 HRRZ C,(C)
044 CAIL B,QARRAY ;REMEMBER, SYMBOLS DENOTING FUNCTION PROPS
045 CAILE B,QFEXPR ; ARE CONSECUTIVE IN SYMBOL SPACE
046 100 040 JRST MAPL1
047 CAIE B,QARRAY
048 CAIN B,QSUBR
049 102 006 JRST MAPL5A ;GO FIGURE OUT JCALL FOR A SUBR OR ARRAY
050 CAIE B,QLSUBR
051 102 002 JRST MAPL5 ;FOOEY, IT'S SOMETHING WE CAN'T LINK TO WELL
052 101 048 PUSH P,CMAPL3
053 HRLI A,(JCALL 16,)
MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 100.1
054 101 056 MOVEI B,MAPL23
055 MAPL1B: HRRM B,-1(P) ;B HAS MODE - SAVE IT
056 PUSH P,A ;SAVE FN (MAYBE WITH JCALL K, IN LEFT HALF)
057 101 025 JRST MAPL2
MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 101
001
002 181 046 MAPL3: MOVE D,(P) ;GET FUNCTION CALL FROM STACK
003 181 046 TLNE D,700000 ;SKIP IF IT DIDN'T GET CLOBBERED
004 101 008 JRST MAPL3A
005 101 058 MOVEI D,MAPL24 ;OH, WELL! MIGHT AS WELL USE MODE
006 181 046 HRRM D,-2(P) ; FOR UNCLOBBERABLE FNS
007 CMAPL6:
008 101 010 MAPL3A: MOVEI D,MAPL6
009 181 046 MOVEM D,-1(P) ;WE ONLY NEED TO DO A MAPL3 CHECK ONCE
010 181 046 MAPL6: MOVE D,-3(P) ;D POINTS TO LIST1 ON STACK
011 035 006 HLRZ C,-1(D) ;C GETS POINTER TO LAST OF VALUE
012 101 019 JUMPE C,MAPL7 ;THIS IS REALLY A MAP OR MAPC
013 HLLZ B,-2(P) ;GET CODE IN LAFT HALF OF B
014 TLNE B,4
015 102 016 JRST MAPL8 ;MAPCAN OR MAPCON
016 073 010 PUSHJ P,CONS ;MAPCAR OR MAPLIST - NOTE THAT B IS NIL
017 035 006 HRRM A,(C) ;CLOBBER INTO END OF LIST
018 181 046 MAPL6A: HRLM A,-1(D) ;SAVE NEW LAST POINTER
019 181 046 MAPL7: MOVE TT,(D)
020 MAPL7A: HRRZ A,(TT) ;TAKE CDR OF ALL LISTS
021 181 046 MOVEM A,(D)
022 181 046 SKIPL TT,1(D)
023 101 020 AOJA D,MAPL7A
024 181 046 MOVE D,TT ;NOW D POINTS TO LIST1 ON STACK AGAIN
025 MAPL2: MOVE B,-2(P)
026 035 006 MOVE C,P ;SAVE C FOR A QUICK GETAWAY
027 PUSH P,-1(P) ;WHERE CALL TO FN SHOULD RETURN
028 181 046 MAPL21: SKIPG A,(D) ;D POINTS TO VECTOR OF LISTS
029 101 051 JRST MAPL22 ;REMEMBER, <-N,,XXX> IS JUST AFTER <LISTN>
030 MOVEI TT,(A)
031 005 042 LSH TT,-SEGLOG
032 036 033 SKIPL ST(TT) ;END-OF-LIST TEST
033 101 039 JRST MAPL40
034 TLNE B,1 ;SKIP UNLESS THIS IS A "CAR" KIND OF MAP
035 HLRZ A,(A)
036 PUSH P,A ;PUSH ARG
037 101 028 AOJA D,MAPL21 ;IF NOT END, GO CHECK OUT NEXT LIST
038
039 101 041 MAPL40: JUMPE A,MAPL4
040 100 020 LER3 [SIXBIT \NON-NULL TERMINATION OF LIST - MAP!\]
041 035 006 MAPL4: MOVE P,C ;THIS POPS OFF FASTLY ANY UNNEEDED STUFF
042 HLRZ T,-3(P) ;GET -N IN T
043 SUBI T,4
044 HRLI T,-1(T)
045 ADD P,T ;FASTLY POP OFF FN, MODE, ALL LISTS, ETC.
046 POP P,A ;FINAL VALUE GOES IN A
047 TLZ A,-1 ;ZERO ANY LEFT HALF GARBAGE
048 101 002 CMAPL3: POPJ P,MAPL3 ;HOORAY!
049
050
051 101 041 MAPL22: JUMPE A,MAPL4 ;NIL IS NORMAL END-OF-LIST
052 SETZB A,B ;MAY HAVE GARBAGE IN LEFT HALVES
053 181 046 HLRE T,(D) ;T GETS -N IN CASE OF LSUBR CALL
MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 101.1
054 181 046 MOVE TT,1(D) ;GET MODE (D POINTS TO <-N,,XXX> ON STACK)
055 071 024 JSP R,(TT) ;FOR SUBRS, GOES TO PDLA2-N
056 209 025 MAPL23: XCT 3(D) ;GO HERE FOR LSUBRS
057
058 022 063 MAPL24: MOVEM T,UUTSV ;GO HERE FOR UNCLOBBERABLE CALL
059 181 046 MOVE T,3(D) ;SAVE SOME OF THE UUOH TROUBLE BY
060 HRLI T,(JCALLF 16,) ; ENTERING THE UUO MESS MORE DIRECTLY
061 MOVEM T,40
062 TLZ T,-1
063 071 024 MOVEI R,1 ;R=1 MEANS LSUBR CALL
064 022 058 SETZM UUOH
065 206 013 JRST UUOH0A
MAPPING FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 102
001
002 101 007 MAPL5: PUSH P,CMAPL6 ;SET UP FOR UNCLOBBERABLE FN CALL
003 101 058 MOVEI B,MAPL24
004 100 055 JRST MAPL1B
005
006 MAPL5A: HLRE T,-1(P)
007 064 014 CAMGE T,XC-5 ;CHECK NUMBER OF ARGS FOR FN
008 102 002 JRST MAPL5 ;FOOEY, TOO MANY ARGS FOR SUBR CALL
009 101 048 PUSH P,CMAPL3
010 MOVM TT,T
011 LSH TT,5
012 TLO A,(JCALL)(TT) ;MAKE UP JCALL OF RIGHT # OF ARGS
013 218 051 MOVEI B,PDLA2(T) ;MODE = PDLA2-<# OF ARGS>
014 100 055 JRST MAPL1B
015
016 101 019 MAPL8: JUMPE A,MAPL7 ;NCONC'ING NIL DOES VERY LITTLE
017 035 006 HRRM A,(C) ;CLOBBER INTO LAST OF PREVIOUS THING
018 086 015 PUSHJ P,LAST ;FIND LAST OF THIS NEW FROB
019 101 018 JRST MAPL6A
020
021 102 027 .MAP: JSP TT,.MAP1 ;MAPCAN
022 102 027 JSP TT,.MAP1 ;MAPCON
023 102 027 JSP TT,.MAP1 ;MAPC
024 102 027 JSP TT,.MAP1 ;MAP
025 102 027 JSP TT,.MAP1 ;MAPCAR
026 102 027 JSP TT,.MAP1 ;MAPLIST
027 059 031 .MAP1: JUMPE A,CPOPJ
028 TLNE A,-1 ;RIDICULOUS CHECK FOR HORRIBLE
029 .VALUE ; COMPILER LOSSES
030 PUSH P,B ;LIST IN A, FUNCTION IN B,
031 PUSH P,A ;NUMBER IN TT IS INDEX
032 MOVNI T,2
033 102 021 10$ SUBI TT,.MAP+A ;LOSING D10!!!
034 10$ MOVNS TT ;NO NEGATIVE RELOC ALLOWED!
035 102 021 .ELSE MOVNI TT,-.MAP-A(TT)
036 100 023 JRST $MAPCAN(TT)
037
038
039 102 048 SET: JSP D,SETCK ;SUBR 2
040 EXCH B,A ;FORTUNATELY, NOT USED BY COMPILED CODE
041 094 012 JSP T,PDLNMK
042 EXCH B,A
043 EXCH B,AR1
044 057 007 JSP T,.SET1
045 EXCH B,AR1
046 POPJ P,
047
048 080 013 SETCK: JSP T,SPATOM
049 JSP T,PNGE1
050 209 011 JRST (D)
VARIOUS BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 103
001
002 SUBTTL VARIOUS BREAK ROUTINES
003
004 059 031 $BREAK: JUMPE A,CPOPJ ;*BREAK - SUBR 2
005 $BRK0: MOVEI A,(B) ;A = BREAKP, B = BREAKID
006 HRRZ B,V.
007 HRRZ AR1,VIPLUS
008 HRRZ AR2A,VIDIFF
009 048 005 JSP T,SPECBIND ;DO *NOT* BIND ↑R
010 TAPRED ;↑Q
011 TTYOFF ;↑W
012 Q% TYIMAN
013 Q% TMBBC
014 VEVALHOOK ;EVALHOOK
015 V%TERPRI ;TERPRI
016 0 B,V. ;*
017 0 AR1,VIPLUS ;+
018 0 AR2A,VIDIFF ;-
019 002 048 IFN QIO,[
020 MOVEI B,$DEVICE
021 035 006 MOVEI C,UNTYI
022 ;; MOVEI AR1,READP
023 ;; MOVEI AR2A,UNRD
024 048 005 JSP T,SPECBIND
025 0 B,TYIMAN
026 035 006 0 C,UNTYIMAN
027 ;; 0 AR1,READPMAN
028 ;; 0 AR2A,UNREADMAN
029 ] ;END OF IFN QIO
030 020 019 Q% SETZM RDOBCT
031 MOVEI AR2A,TRUTH
032 048 005 JSP T,SPECBIND
033 0 AR2A,V%TERPRI
034 STRT 17,[SIXBIT \↑M;BKPT !\]
035 Q% PUSHJ P,PRINC ;PRINC BREAK ID
036 Q$ HRRZ AR1,VMSGFILES
037 Q$ TLO AR1,200000
038 Q$ PUSHJ P,$PRINC
039 STRT 17,STRTCR
040 049 033 PUSHJ P,UNBIND ;UNBIND V%TERPR
041 MOVE A,VIDIFFERENCE
042 MOVEM A,VIPLUS
043 055 035 MOVEI D,BRLP ;FUNCTION TO EXECUTE
044 055 011 PUSHJ P,BRGEN ;CATCH AND ERRSET AROUND A READ-EVAL-PRINT LOOP
045 030 043 Q% SKIPN LINMODE
046 044 015 Q$ JSP F,LINMDP
047 PUSHJ P,ITERPRI
048 049 033 Q$ PUSHJ P,UNBIND
049 049 033 JRST UNBIND
050
051 CB: SKIPN V.RSET ;CALL BREAK - *RSET ERROR
052 POPJ P,
053 SKIPA B,[Q.R.TP]
VARIOUS BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 103.1
054 Q% CN.HB: MOVEI B,QCN.H ;CONTROL-H BREAK
055 Q$ CN.BB: MOVEI B,QCN.B ;CONTROL-B BREAK
056 054 054 PUSHJ P,IOGBND
057 164 094 Q$ PUSH P,CUNBIND
058 103 102 JRST BKCOM2
059
060 UDFB: MOVEI B,QUDF ;UNDEFINED FUNCTION BREAK
061 103 088 JRST BKCOM
062
063 UBVB: MOVEI B,QUBV ;UNBOUND VARIABLE BREAK
064 103 088 JRST BKCOM
065
066 WTAB: MOVEI B,QWTA ;WRONG TYPE OF ARGUMENT BREAK
067 103 088 JRST BKCOM
068
069 UGTB: MOVEI B,QUGT ;UNSEEN GO TAG BREAK
070 103 088 JRST BKCOM
071
072 WNAB: MOVEI B,QWNA ;WRONG # ARGS BREAK
073 103 088 JRST BKCOM
074
075 GCLB: MOVEI B,QGCL ;FAILED TO GARBAGE-COLLECT ENOUGH SPACE BREAK
076 103 088 JRST BKCOM
077
078 PDLB: MOVEI B,QPDL ;PDL OVERFLOW BREAK
079 103 088 JRST BKCOM
080
081 GCOB: MOVEI B,QGCO ;GC OVERFLOW BREAK
082 103 088 JRST BKCOM
083
084 Q$ IOLB: MOVEI B,QIOL ;I/O LOSSAGE BREAK
085 103 088 Q$ JRST BKCOM
086
087 FACB: MOVEI B,QFAC ;FAILED ACTION REQUEST BREAK
088 BKCOM:
089 054 054 Q% PUSHJ P,IOGBND
090 SAVE A B
091 Q% MOVEI A,NIL
092 Q% PUSHJ P,ERRPRINT
093 002 048 IFN QIO,[
094 103 110 PUSH P,CBKCM0
095 064 009 PUSH P,R70
096 PUSH P,VMSGFILES
097 MOVNI T,2
098 209 011 JRST ERRPRINT
099 BKCOM0:
100 ] ;END OF IFN QIO
101 071 024 JSP R,RSTR2
102 BKCOM2: MOVEI AR1,READTABLE
103 MOVEI AR2A,OBARRAY
104 048 005 JSP T,SPECBIND
105 0 A,VARGS ;SPECIAL VALUE CELL OF ARGS
106 0 AR1,VREADTABLE ;RESET READTABLE AND OBARRAY
VARIOUS BREAK ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 103.2
107 0 AR2A,VOBARRAY ; TO STANDARD (INITIAL) ONES
108 Q$ TAPWRT ;BIND ↑R TO NIL
109 131 052 Q% SETZ A,
110 103 099 Q$ CBKCM0: SETZ A,BKCOM0
111 069 004 PUSHJ P,NOINTERRUPT
112 MOVEI A,TRUTH
113 103 004 PUSHJ P,$BREAK
114 BKCOM1:
115 049 033 Q% PUSHJ P,UNBIND
116 049 033 JRST UNBIND
117
INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 104
001
002 SUBTTL INTERN FUNCTION AND RELATED ROUTINES
003
004 INTERN: PUSH P,A ;ONLY INIT ENTERS INTERN AT INTRN0
005 082 048 INTRN3: PUSHJ P,PNGET ;MUST SAVE F - SEE FASLOAD
006 021 012 SETOM LPNF
007 021 018 INTRN1: SETZM RINF
008 097 007 JSP TT,ATMHSH ;LEAVES ATOM'S HASHKEY IN T
009 MOVEI AR2A,(A)
010 035 006 HLRZ C,(A)
011 INTRN: TLZ T,400000
012 002 044 IDIVI T,OBTSIZ
013 HRLM TT,(P)
014 INTRN4: LOCKI ;SO THAT NO INTERRUPT SNEAKS SOMETHING
015 181 046 SKIPN D,VOBARRAY ; ON THE OBLIST JUST AFTER WE DECIDE IT ISNT THERE
016 209 011 JRST INTNCO
017 035 006 MOVEI C,(D)
018 005 042 LSH C,-SEGLOG
019 036 033 MOVE C,ST(C)
020 035 006 TLNN C,SA
021 209 011 JRST INTNCO
022 181 046 MOVE T,ASAR(D)
023 TLNN T,AS<OBA>
024 209 011 JRST INTNCO
025 ROT TT,-1 ;GET BUCKET
026 JUMPL TT,.+3
027 181 046 HLRZ A,@TTSAR(D)
028 JRST .+2
029 181 046 HRRZ A,@TTSAR(D)
030 PUSH FXP,TT
031 105 007 JUMPE A,MAKA0
032 035 006 MOVEI C,A
033 035 006 MAKF: MOVE AR1,C
034 035 006 HRRZ C,(C)
035 105 008 JUMPE C,MAKA
036 035 006 HLRZ AR1,(C)
037 SKIPN AR1
038 039 025 TROA AR1,$$$NIL ;BEWARE THE SKIP!
039 MAKF1: HLRZ AR1,(AR1)
040 HRRZ AR1,1(AR1)
041 021 018 SKIPN T,RINF ;RINF HAS ZERO WHEN IN REGULAR INTERN
042 MOVEI T,(AR2A)
043 105 023 MAK2: JUMPE AR1,MAK1
044 104 033 JUMPE T,MAKF
045 HLRZ B,(AR1)
046 MOVE B,(B)
047 021 018 SKIPN RINF
048 104 052 JRST MAK4
049 032 010 CAME B,@RNTN2 ;<END OF PNAME>(T)
050 104 033 JRST MAKF ;COMPARE FOR RINTERN
051 104 056 AOJA T,MAK3
052 181 046 MAK4: HLRZ D,(T) ;COMPARE FOR REGULAR INTERN
053 181 046 CAME B,(D)
INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 104.1
054 104 033 JRST MAKF
055 HRRZ T,(T)
056 MAK3: HRRZ AR1,(AR1)
057 104 043 JRST MAK2
INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 105
001
002 MAKA3: HRRZ A,(P)
003 021 012 SKIPL LPNF
004 072 013 PUSHJ P,SYCONS
005 105 012 JRST MAKA2
006
007 181 046 MAKA0: TDZA D,D ;D=0 => BUCKET WAS EMPTY BEFORE THIS CALL
008 181 046 MAKA: MOVEI D,1
009 021 018 MOVN C,RINF ;MAKE-UP NEW ATOM
010 105 002 JUMPE C,MAKA3
011 072 004 PUSHJ P,PNGNK
012 073 008 MAKA2: PUSHJ P,NCONS
013 MOVE TT,(FXP)
014 105 017 JUMPE D,MAKA5
015 HRRM A,(AR1) ;NCONC ONTO END OF BUCKET
016 105 022 JRST MAKA4
017 181 046 MAKA5: HRRZ D,VOBARRAY
018 JUMPL TT,.+3
019 181 046 HRLM A,@TTSAR(D)
020 209 011 JRST .+2
021 181 046 HRRM A,@TTSAR(D)
022 035 006 MAKA4: SKIPA C,A
023 104 033 MAK1: JUMPN T,MAKF ;ATOM FOUND ON OBLIST
024 035 006 HLRZ A,(C)
025 POP FXP,TT ;SHOULD EXIT WITH OBTBL BUCKET # IN TT
026 064 009 SUB P,R70+1
027 UNLKPOPJ
028
INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 106
001
002 ;;; COME HERE TO INTERN AN ATOM WHOSE PRINT NAME IS IN PNBUF.
003
004 022 019 RINTERN: CAMN C,[350700,,PNBUF] ;SAVES F
005 106 024 JRST RINTN1
006 RINTN0: PUSH FXP,T
007 072 057 PUSH P,CPXTJ
008 PUSH P,A ;ENTERING INTERN AFTER THE "PUSH P A", SO MUST DO HERE
009 021 012 SKIPL LPNF
010 104 007 JRST INTRN1
011 035 006 ADDI C,1
012 032 010 HRRM C,RNTN2
013 022 019 2DIF [MOVEI C,(C)]0,PNBUF
014 021 018 MOVNM C,RINF
015 022 019 INTRN2: MOVEI C,PNBUF ;DUPLICATE PNAME HASHING ALGORITHM
016 022 019 MOVE T,PNBUF ; AS USED IN SXHASH
017 021 018 MOVN D,RINF
018 181 046 SOJLE D,.+3
019 022 019 XOR T,PNBUF(D)
020 209 011 JRST .-2
021 LSH T,-1
022 104 011 JRST INTRN
023
024 021 012 RINTN1: SKIPL LPNF
025 106 006 JRST RINTN0
026 022 019 MOVE TT,PNBUF
027 ROT TT,6
028 002 044 ADDI TT,<OBTSIZ+1>/2 ;### OBTSIZ MUST BE ODD
029 181 046 MOVE D,VOBARRAY
030 JUMPL TT,.+3
031 181 046 HLRZ A,@1(D)
032 209 011 JRST .+2
033 181 046 HRRZ A,@1(D)
034 059 031 JUMPN A,CPOPJ
035 PUSH FXP,TT
036 106 006 PUSHJ P,RINTN0
037 POP FXP,TT
038 181 046 MOVE D,VOBARRAY
039 JUMPL TT,.+3
040 181 046 HRLM A,@1(D)
041 POPJ P,
042 181 046 HRRM A,@1(D)
043 POPJ P,
044
INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 107
001
002
003 107 015 IMPLODE: SKIPA T,CRINTERN ;SUBR 1
004 072 011 MAKNAM: MOVEI T,PNGNK1 ;SUBR 1
005 107 041 JUMPE A,MKNM4
006 PUSH P,T
007 Q% PUSH P,MKNM3
008 Q% HRRZM A,MKNM3
009 Q$ PUSH P,RDLARG
010 Q$ HRRZM A,RDLARG
011 107 018 MOVEI T,MKNM1
012 PUSHJ FXP,MKNR6C
013 Q% POP P,MKNM3
014 Q$ POP P,RDLARG
015 106 004 CRINTERN: POPJ P,RINTERN
016
017 002 048 IFN QIO,[
018 MKNM1: SKIPN A,RDLARG
019 POPJ P,
020 HRRZ B,(A)
021 MOVEM B,RDLARG
022 HLRZ A,(A)
023 107 050 MKNM2: JSP T,CHNV1
024 059 039 JRST POPJ1
025
026 ] ;END OF IFN QIO
027
028 002 048 IFE QIO,[
029 MKNM1: SKIPN B,MKNM3 ;GET NEXT CHAR FOR MAKNAM
030 081 044 JRST FALSE
031 MKRL1: HRRZ A,(B)
032 HRRM A,MKNM3
033 HLRZ A,(B) ;B HOLDS LIST FROM WHICH TO GET NEXT CHAR FOR
034 107 050 JSP T,CHNV1
035 MOVEI A,(TT)
036 POPJ P,
037 ] ;END OF IFE QIO
038
039
040 106 004 RDL12: MOVEI T,RINTERN
041 022 019 MKNM4: SETZM PNBUF
042 JSP TT,IRDA
043 209 011 JRST (T) ;PNGNK1 OR RINTERN, THEN POPJ P,
044
045
046
047 ;;; GET CHARACTER NUMERIC VALUE
048
049 CHNV1X: TLO T,1
050 CHNV1: SKOTT A,SY+FX
051 107 064 JRST CHNV1C
052 TLNN TT,SY
053 107 060 JRST CHNV1A
INTERN FUNCTION AND RELATED ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 107.1
054 CHNV1D: HLRZ TT,(A)
055 HRRZ TT,1(TT)
056 HLRZ TT,(TT)
057 LDB TT,[350700,,(TT)]
058 107 062 JRST CHNV1B
059
060 CHNV1A: MOVE TT,(A)
061 TLNN T,1
062 CHNV1B: TDNN TT,[-200]
063 209 011 JRST (T)
064 086 009 CHNV1C: WTA [NOT ASCII CHARACTER!]
065 107 050 JRST CHNV1
066
DEFPROP AND DEFUN LISP.393[MAC,LSP] 01/17/78 Page 108
001
002 SUBTTL DEFPROP AND DEFUN
003
004 ;;; THE BASIC IDEA OF DEFPROP IS:
005 ;;; (DEFUN DEFPROP FEXPR (X)
006 ;;; (DO () ((NULL (REMPROP (CAR X) (CADDR X)))))
007 ;;; (PUTPROP (CAR X) (CADR X) (CADDR X)))
008 ;;; THAT IS, REMOVE *ALL* OCCURRENCES OF THE PROPERTY BEFORE
009 ;;; PUTTING ON THE NEW VALUE.
010
011 DEFPROP: ;FEXPR
012 REPEAT 2, PUSH P,A
013 108 034 JSP T,DFPR2
014 108 039 JSP T,DFPR1
015 209 011 JRST DFPER
016 035 006 HRRZ TT,(C)
017 JUMPN TT,DFPER
018 HLRZ A,(A)
019 HLRZ AR1,(B)
020 035 006 HLRZ B,(C)
021 035 006 MOVEI C,(B)
022 ;SYMBOL IN A; PROPERTY NAME IN B *AND* C; PROPERTY VALUE IN AR1.
023 DEF1: MOVEI AR2A,(A) ;DEFUN COMES IN HERE
024 085 003 DEF1B: PUSHJ P,REMPROP ;REMPROP SAVES C, AR1, AR2A
025 MOVEI B,(AR1)
026 108 024 JUMPN A,DEF1B ;REMOVE ALL OCCURRENCES OF THE PROPERTY
027 MOVEI A,(AR2A)
028 084 015 PUSHJ P,PUTPROP
029 DEF9: POP P,A ;PUT NEW VALUE FOR PROPERTY
030 POPI P,1
031 $CAR: HLRZ A,(A)
032 108 031 C$CAR: POPJ P,$CAR
033
034 DFPR2: HLRZ B,(A) ;SOME HAIRY CHECKS FOR DEFPROP AND DEFUN
035 SKOTT B,SY ;SKIPS ON *FAILURE* TO GET A VALID SYMBOL
036 JUMPN B,1(T)
037 209 011 JRST (T)
038
039 DFPR1: JUMPE A,(T) ;MORE HAIRY CHECKS FOR DEFPROP AND DEFUN
040 HRRZ B,(A) ;SKIPS ON *SUCCESS*
041 JUMPE B,(T) ;LEAVES STUFF SPREAD OUT IN A, B, C
042 035 006 HRRZ C,(B)
043 035 006 JUMPE C,(T)
044 209 011 JRST 1(T)
DEFPROP AND DEFUN LISP.393[MAC,LSP] 01/17/78 Page 109
001
002 ;;; (DEFUN <SPEC> <FLAG> <ARGS> . <BODY>) DEFINES A FUNCTION.
003 ;;; <SPEC> AND <FLAG> MAY BE INTERCHANGED.
004 ;;; <FLAG> MAY BE OMITTED, OR MAY BE "EXPR", "FEXPR", OR "MACRO".
005 ;;; <SPEC> MAY BE A SYMBOL (THE NAME OF THE FUNCTION), OR
006 ;;; A LIST OF TWO TO FOUR SYMBOLS (IN WHICH CASE THE FLAG "MACRO"
007 ;;; IS ILLEGAL). <ARGS> IS A NON-NIL SYMBOL OR A LIST OF SYMBOLS;
008 ;;; THE FORMER INDICATES AN LEXPR (INCOMPATIBLE WITH THE "MACRO"
009 ;;; AND "FEXPR" FLAGS).
010 ;;; IF THE VALUE OF THE SWITCH DEFUN IS T, THEN THE EXPR-HASH HACK
011 ;;; IS ENABLED. IN THIS CASE, DEFUN AVOIDS MAKING THE INTERPRETIVE
012 ;;; DEFINITION IF HASHING THE DEFINITION INDICATES THAT IT IS
013 ;;; THE SAME AS THE CURRENT, PRESUMABLY COMPILED, DEFINITION.
014 ;;; THE VARIOUS CASES ARE:
015 ;;; FORM OF <SPEC>:
016 ;;; FOO (FOO BAR) (FOO BAR BAZ) (FOO BAR BAZ QUUX)
017 ;;; EXPR-HASH PROPERTY IS ON THE ATOM:
018 ;;; FOO (GET 'FOO 'BAR) - NONE - FOO
019 ;;; [IF THIS IS A SYMBOL]
020 ;;; EXPR-HASH PROPERTY INDICATOR IS:
021 ;;; EXPR-HASH EXPR-HASH - NONE - QUUX
022 ;;; DEFUN PUTS THE FUNCTION DEFINITION ON FOO UNDER THE PROPERTY:
023 ;;; EXPR/FEXPR/MACRO BAR BAR BAR
024 ;;; COMPILER PUTS THE FUNCTION DEFINITION ON FOO UNDER THE PROPERTY:
025 ;;; SUBR/FSUBR/LSUBR BAR * BAZ BAZ
026 ;;; * THE PROPERTY WILL BE A SYMBOL |FOO BAR| WHICH IN TURN
027 ;;; WILL HAVE THE APPROPRIATE SUBR/FSUBR/LSUBR PROPERTY.
028
029 DEFUN: ;FEXPR
030 REPEAT 2, PUSH P,A
031 HLRZ AR1,(A)
032 CAIL AR1,QEXPR ;REMEMBER, (QEXPR, QFEXPR, QMACRO)
033 CAILE AR1,QMACRO ; ARE IN THAT ORDER
034 109 039 JRST DEF7
035 HRRZ A,(A) ;(DEFUN <FLAG> <SPEC> ...)
036 HRRM A,(P) ;CDR OFF FLAG, LEAVING FLAG IN AR1
037 109 049 JRST DEF3
038
039 DEF7: HRRZ A,(A)
040 HLRZ AR1,(A)
041 CAIN AR1,QEXPR
042 109 049 JRST DEF3
043 CAIE AR1,QFEXPR
044 CAIN AR1,QMACRO
045 109 049 JRST DEF3 ;(DEFUN <SPEC> <FLAG> ...)
046 MOVEI AR1,QEXPR ;(DEFUN <SPEC> ...); <FLAG> DEFAULTS TO EXPR
047 MOVE A,(P)
048 ;<FLAG> IS IN AR1; THE CDR OF A IS (<ARGS> ...); THE CAR OF (P) IS <SPEC>.
049 108 039 DEF3: JSP T,DFPR1 ;MAKE SURE WE HAVE AT LEAST TWO THINGS
050 209 011 JRST DEFNER
051 MOVEI A,QLAMBDA ;CREATE AN APPROPRIATE LAMBDA-EXPRESSION
052 073 010 PUSHJ P,CONS
053 035 006 MOVEI C,(A)
DEFPROP AND DEFUN LISP.393[MAC,LSP] 01/17/78 Page 109.1
054 HRRZ A,(P) ;THE CAR OF THIS IS <SPEC>
055 MOVEI AR2A,QXPRHSH
056 108 034 JSP T,DFPR2 ;CHECK TO SEE IF ATOM (SKIPS UNLESS SYMBOL)
057 109 071 JRST DEF3A
058 MOVEM B,(P) ;SAVE THIS FUNNY LIST
059 CAIN AR1,QMACRO
060 209 011 JRST DEFNER ;FUNNY FORMAT AND MACRO FLAG DON'T MIX
061 HRRZ B,(B) ;PECULIAR FORMAT: (NAME EXPRNAME ...)
062 HLRZ AR1,(B)
063 JUMPE AR1,DEFNER
064 HRRZ B,(B)
065 SETO AR2A, ;FOR A 2-LIST, USE "EXPR-HASH" FOR EXPR-HASH PROPERTY,
066 109 071 JUMPE B,DEF3A ; BUT MUST ALSO LOOK IN A DIFFERENT PLACE
067 HRRZ B,(B)
068 109 098 JUMPE B,DEF5 ;3-LISTS DON'T USE EXPR-HASH FEATURE
069 HLRZ AR2A,(B) ;4-LISTS USE THE FOURTH ITEM
070 ;EXPR-HASH PROP NAME IN AR2A, OR -1; DEFINITION IN C; PROPERTY NAME IN AR1; NAME IN CAR OF (P).
071 DEF3A: SKIPN VDEFUN ;THE VALUE OF DEFUN CONTROLS
072 109 098 JRST DEF5 ; THE EXPR-HASH HACK
073 HLRZ A,@(P)
074 109 084 JUMPGE AR2A,DEF6 ;JUMP UNLESS 2-LIST FORMAT
075 MOVEI B,(AR1) ;MUST GET VALUE OF EXISTING PROPERTY
076 082 029 PUSHJ P,GET1 ; AND SEARCH IT FOR THE EXPR-HASH PROPERTY
077 109 098 JUMPE A,DEF5 ;IF NONE, LOSE
078 080 042 JSP T,STENT
079 TLNN TT,SY ;NO EXPR-HASH IF NOT A SYMBOL
080 109 098 JRST DEF5
081 MOVEI AR2A,QXPRHSH
082 ;A HAS THE ATOM CONTAINING THE EXPR-HASH PROPERTY, IF ANY.
083 ;AR2A HAS AN ACTUAL EXPR-HASH PROPERTY NAME.
084 DEF6: MOVEI B,(AR2A)
085 MOVEI AR2A,(A) ;SAVE ATOM INVOLVED
086 082 029 PUSHJ P,GET1 ;GET EXPR-HASH PROPERTY
087 109 098 JUMPE A,DEF5 ;DO DEFUN IF NONE
088 MOVE F,(A) ;EXPR-HASH PROPERTY VALUE BETTER BE FIXNUM!
089 060 005 PUSHJ FXP,SAV5M1
090 035 006 MOVEI A,(C) ;CANONICAL LAMBDA FORM
091 097 002 PUSHJ P,SXHASH+1 ;NCALL 1,.FUNCTION SXHASH
092 060 021 PUSHJ FXP,RST5M1
093 CAMN TT,F
094 108 029 JRST DEF9 ;AHA! HASHES MATCH! FORGET IT.
095 MOVEI A,(AR2A) ;HASHES MATCH, SO FLUSH THE EXPR-HASH PROPERTY
096 085 003 PUSHJ P,REMPROP ; AND THEN PERFORM THE DEFINITION
097 ;THE CAR OF (P) IS THE ATOM TO PUTPROP ONTO; AR1 IS THE PROPERTY NAME; C IS THE VALUE.
098 DEF5: HLRZ A,@(P)
099 035 006 EXCH C,AR1
100 035 006 MOVEI B,(C)
101 108 023 JRST DEF1 ;GO DO THE PUTPROP
TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 110
001
002 SUBTTL TYIPEEK FUNCTION
003
004 002 048 IFE QIO,[
005
006 139 017 TYIPEEK: SKIPA D,[MAKNUM]
007 181 046 MOVEI D,A2TT
008 AOJL T,TYPKER
009 MOVNI TT,1 ;-1 => NO ARG, SO ANY NEXT CHAR IS TAKEN
010 110 020 JUMPN T,TYPK4D
011 TYPK4: POP P,A ;IF ARG GIVEN, THEN SCAN UNTIL SPECIFIC KIND OF CHAR IS FOUND
012 MOVNI TT,2 ;-2 => ARG OF T GIVEN
013 CAIN A,TRUTH ;ARG OF T MEANS SCAN FOR READ STARTUP CHAR
014 110 020 JRST TYPK4D
015 065 007 JSP T,FXNV1 ;IF ARG >777, THEN IT IS SYNTAX TYPE OF CHAR TO FIND
016 CAIGE TT,1000 ;IF ARG < 1000, THE IT IS SPECIFIC CHAR'S ASCII VALUE
017 110 020 JRST TYPK4D
018 NW% LSH TT,-9.
019 TLO TT,400000
020 181 046 TYPK4D: PUSH P,D
021 PUSH FXP,TT
022 065 067 JSP T,RSXST
023 TYPK4A: SKIPN A,TYIMAN
024 110 037 JRST TYPK5
025 PUSHJ P,(A)
026 CAIN A,203 ;PSEUDO-SPACE AT END OF STREAM
027 035 006 MOVEI A,↑C
028 035 006 CAIN A,↑C
029 110 049 JRST TYPK3B
030 111 026 PUSHJ P,TYPK7
031 110 023 JRST TYPK4A
032 MOVEM A,TMBBC
033 064 009 TYPX: SUB FXP,R70+1
034 POPJ P,
035
036
037 TYPK5: SKIPN TAPRED
038 111 004 JRST TYPK6
039 TYPK5A: PUSHJ P,URED
040 110 048 JRST TYPK3
041 111 026 PUSHJ P,TYPK7
042 110 039 JRST TYPK5A
043 035 006 EXCH A,C
044 PUSHJ P,READ3 ;BACK UP UTIBP
045 035 006 EXCH A,C
046 110 033 JRST TYPX
047
048 TYPK3: JSP A,.UEOF
049 TYPK3B: MOVEI A,3 ;3 IS ASCII E-O-F
050 110 033 JRST TYPX
051
TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 111
001
002 ;;; IFE QIO
003
004 TYPK6: SKIPE A,RDTYBF
005 111 012 JRST TYPK6A
006 TYPK6B: PUSHJ P,TYIN
007 111 026 PUSHJ P,TYPK7
008 110 037 JRST TYPK5
009 032 006 MOVEM A,PBFTY
010 110 033 JRST TYPX
011
012 TYPK6A: HLRZ A,(A)
013 CAIE A,203
014 111 026 PUSHJ P,TYPK7
015 209 011 JRST .+2
016 110 033 JRST TYPX
017 MOVE A,RDTYBF ;CHAR NOT ACCEPTABLE, SO CDR THE RDTYBF
018 HRR A,(A) ;AND TRY AGAIN
019 TRNN A,-1
020 MOVEI A,NIL
021 MOVEM A,RDTYBF
022 111 012 JUMPN A,TYPK6A
023 111 006 JRST TYPK6B
024
025
026 TYPK7: SKIPL T,(FXP) ;SKIP IF SOUGHT CHAR IS PRESENT IN A
027 111 036 JRST TYPK7A
028 020 049 NW% HLRZ TT,@RSXTB ;SIGN BIT MEANS WE ARE LOOKING FOR RCT TYPE
029 020 049 NW$ MOVE TT,@RSXTB
030 064 014 CAMN T,XC-2 ;-2 => ARG OF T, SO LOOK FOR READ STARTUP CHAR
031 111 040 JRST TYPK7B
032 064 014 CAME T,XC-1 ;-1 => NO ARG, SO ANY NEXT CHAR IS ACCEPTABLE
033 TDNE TT,T
034 AOS (P)
035 POPJ P,
036 TYPK7A: CAIN A,(T) ;OTHERWISE, LOOKING FOR SPECIFIC CHAR
037 AOS (P)
038 POPJ P,
039
040 TYPK7B:
041 NW% TRC TT,4040 ;IN (TYIPEEK T) MODE
042 NW% TRCE TT,4040
043 NW$ TLNE TT,(RS.MAC) ;SKIP IF NOT MACRO
044 NW$ TRNN TT,RS.ALT ;MACRO - SKIP IF SPLICING
045 111 052 JRST TYPK7D
046 060 005 PUSHJ FXP,SAV5M1
047 020 049 HRRZ A,@RSXTB
048 CALLF 0,(A) ;EXECUTE SPLICING MACRO, AND TRY AGAIN
049 060 021 PUSHJ FXP,RST5M1
050 POPJ P,
051
052 TYPK7D:
053 NW% TRNE TT,266217 ;CODES TO START OFF A READ
TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 111.1
054 NW$ TDNE TT,[1266217000] ;CODES TO START OFF A READ
055 AOS (P)
056 POPJ P,
057
058 ] ;END OF IFE QIO
TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 112
001
002 002 048 IFN QIO,[
003
004 TYIPEEK: ;LSUBR (0 . 3) NCALLABLE
005 064 007 SKIPA F,CFIX1
006 059 031 MOVEI F,CPOPJ
007 181 046 MOVEI D,QTYIPEEK
008 064 014 CAMGE T,XC-3
009 209 011 JRST WNALOSE
010 SKIPE T ;NO ARGS <=> ONE ARG OF NIL
011 AOSA T ;ELSE DECREMENT ARG COUNT FOR INCALL
012 064 009 PUSH P,R70
013 181 046 MOVEI D,(P)
014 181 046 ADDI D,(T)
015 059 031 MOVEI AR2A,CPOPJ
016 181 046 EXCH AR2A,(D)
017 181 046 JSP D,XINCALL ;PROCESS ARGS 2 AND 3
018 QTYIPEEK ; (ALSO PUSHES F ONTO P)
019 MOVEI A,Q%TYI
020 020 035 HRLZM A,BFPRDP
021 MOVEI A,(AR2A) ;GET ARG 1 IN A
022 068 059 JSP T,GTRDTB ;GET READTABLE IN AR2A
023 112 027 JUMPN A,TYPK1 ;NIL => ACCEPT ANY CHAR
024 PEEK: HRRZ TT,TYIMAN ;CALL TYIMAN ONE EARLY TO
025 209 011 JRST -1(TT) ; SPECIFY PEEKING
026
027 TYPK1: CAIE A,TRUTH ;T => SEARCH FOR READER START
028 110 048 JRST TYPK3 ; CHARACTER (E.G. PAREN, MACRO)
029 112 024 TYPK1C: PUSHJ P,PEEK ;PEEK AT A CHAR
030 112 067 JUMPL TT,TYPK9A ;HIT EOF - TAKE A "SOFT" EOF, RETURN -1
031 MOVE T,@TTSAR(AR2A) ;PEEK SETS UP AR2A
032 TLC T,4040 .SEE SYNTAX
033 TLCE T,4040
034 112 041 JRST TYPK1F
035 PUSH P,T
036 PUSHJ P,@TYIMAN
037 POP P,T
038 CALLF 0,(T) ;HIT A HORRIBLE SPLICING MACRO
039 112 029 JRST TYPK1C ;GO BACK AND TRY AGAIN
040
041 TYPK1F: TLNE T,266217 .SEE SYNTAX ;READER START CHARS
042 POPJ P,
043 TYPK1H: PUSHJ P,@TYIMAN ;CHAR NOT ACCEPTABLE - GOBBLE IT
044 112 029 JRST TYPK1C ;NOW GO TRY AGAIN
045
046 065 007 TYPK3: JSP T,FXNV1 ;ARG MUST BE FIXNUM
047 112 050 JUMPL TT,TYPK3C ;ARG BETWEEN 0 AND 777 =>
048 CAIG TT,777 ; SCAN FOR THAT CHARACTER;
049 TLOA TT,400000 ; OTHERWISE IS A SYNTAX, LSH'ED
050 TYPK3C: LSH TT,-11 ; LEFT BY 11, TO SERVE AS MASK
051 PUSH FXP,TT
052 112 024 TYPK4: PUSHJ P,PEEK ;PEEK AT A CHAR
053 112 066 JUMPL TT,TYPK9 ;SOFT EOF - GO RETURN -1 OR WHATEVER
TYIPEEK FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 112.1
054 181 046 SKIPL D,(FXP) ;SKIP IF SPECIFIC CHARACTER
055 111 004 JRST TYPK6
056 181 046 CAIN TT,(D) ;COMPARE TO ONE WE GOT
057 060 050 JRST POPXTJ ;SUPER WIN
058 TYPK5: PUSHJ P,@TYIMAN ;NOT THE ONE - GOBBLE AND RETRY
059 110 011 JRST TYPK4
060
061 TYPK6: HLRZ T,@TTSAR(AR2A) .SEE SYNTAX
062 181 046 TDNN T,D ;CHECK SYNTAX AGAINST MASK
063 110 037 JRST TYPK5
064 060 050 JRST POPXTJ
065
066 064 009 TYPK9: SUB FXP,R70+1
067 020 030 TYPK9A: SKIPN EOFRTN ;"SOFT" EOF. DOES NOT INVOKE
068 059 043 JRST M1TTPJ ; THE EOFFN, BUT WILL PICK UP
069 209 011 JRST EOF9 ; THE EOFVAL IF NECESSARY.
070
071 ] ;END OF IFN QIO
VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 113
001
002 SUBTTL VALRET, QUIT, AND SUSPEND FUNCTIONS
003
004 113 014 VALRET: JUMPE T,VLRT9
005 057 027 JSP TT,LWNACK
006 LA01,,QVALRET
007 POP P,A
008 113 019 PUSHJ P,VALSTR
009 002 026 IFN ITS,[
010 032 053 SETOM SAWSP
011 022 018 .VALUE MACOUT
012 032 053 SETZM SAWSP
013 ] ;END OF IFN ITS
014 10$ VLRT9: EXIT 1,
015 002 030 10X WARN [HOW TO EXIT 1, IN TENEX]
016 POPJ P,
017
018
019 082 048 VALSTR: PUSHJ P,PNGET
020 022 018 SETZM MACOUT
021 022 018 MOVE D,[MACOUT,,MACOUT+1]
022 022 018 BLT D,MACOUT+LVLRTS-1
023 022 048 MOVSI D,-LVLRTS+1
024 VLRT2: HLRZ B,(A)
025 MOVE TT,(B)
026 022 018 MOVEM TT,MACOUT(D)
027 HRRZ A,(A)
028 181 046 AOBJP D,VALST0
029 113 024 JUMPN A,VLRT2
030 022 018 MOVE D,MACOUT
031 181 046 CAMN D,[ASCII \:kill\]
032 209 011 JRST .+3
033 181 046 CAME D,[ASCII \:KILL\]
034 113 042 JRST VLRT1
035 022 018 MOVE D,MACOUT+1
036 181 046 CAME D,[ASCII \ \]
037 181 046 CAMN D,[ASCII \
038 \]
039 113 050 JRST VLRT3
040 POPJ P,
041
042 181 046 VLRT1: CAMN D,[ASCII \}_.\]
043 113 050 JRST VLRT3
044 181 046 CAME D,[ASCII \}}U\]
045 181 046 CAMN D,[ASCII \}}u\]
046 IT$ .LOGOUT
047 113 014 .ELSE XCT VLRT9
048 POPJ P,
049
050 VLRT3:
051 181 046 IT$ MOVEI D,120000 ;"SILENT KILL"
052 VLRT3A:
053 10$ EXIT
VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 113.1
054 002 030 10X WARN [HOW TO EXIT IN TENEX]
055 002 026 IFN ITS,[
056 .LOGOUT ;TRY TO LOG OUT
057 113 065 JSP T,SIDDTP
058 .VALUE
059 181 046 .BREAK 16,(D)
060
061 VLRT9: .LOGOUT ;TRY TO LOG OUT
062 .VALUE [ASCIZ \:VK \] ;OH, WELL...
063 POPJ P, ;IN CASE LOSER DOES $P FROM IT
064
065 SIDDTP: .SUSET [.ROPTION,,TT]
066 TLNN TT,OPTBRK ;SKIP IF JOB INFERIOR TO DDT
067 209 011 JRST (T) ; (ACTUALLY, IF SUPERIOR HANDLES .BREAK)
068 209 011 JRST 1(T)
069 ] ;END OF IFN ITS
VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 114
001
002 181 046 QUIT: MOVEI D,QQUIT ;LSUBR (0 . 1)
003 AOJL T,S1WNALOSE
004 SKIPE T
005 TDZA A,A ;NO ARG => USE NIL
006 POP P,A
007 CAIN A,TRUTH ;T MEANS KILL AS QUIETLY AS POSSIBLE
008 113 050 JRST VLRT3
009 181 046 MOVEI D,160000 ;VANILLA-FLAVORED KILL
010 CAIN A,Q$ERROR ;ERROR MEANS WE SHOULD KILL INPUT BUFFER
011 181 046 TRZ D,100000
012 MOVEI TT,(A)
013 005 042 LSH TT,-SEGLOG
014 036 033 MOVE TT,ST(TT)
015 TLNE TT,FX
016 181 046 MOVE D,(A) ;FIXNUM ARG => USE FOR .BREAK 16, ARG
017 113 052 JRST VLRT3A
VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 115
001
002 SUSPEND: ;LSUBR (0 . 2)
003 057 027 JSP TT,LWNACK
004 LA012,,QSUSPEND
005 022 018 SETZM MACOUT
006 115 032 JUMPE T,SUSP0
007 115 030 AOJE T,SUSP0C ;JUMP IF ONE ARG
008 POP P,A ;SECOND ARG, IF ANY, IS SAVE FILE NAME FOR HISEG
009 002 029 IFN SAIL,[
010 002 048 IFE QIO,[
011 030 032 SAVEFX UFN1 UFN2 ;SAVE CURRENT FILE NAMES
012 048 005 JSP T,SPECBIND
013 IUNIT
014 PUSHJ P,UINITA ;PARSE SECOND ARG TO SUSPEND
015 UNLOCKI ;UNDO THE LOCKI THAT CRETINOUS UINITA PERFORMED
016 SAVEFX T
017 049 033 PUSHJ P,UNBIND ;POP SAVED FILE NAMES
018 030 031 RSTRFX T UFN2 UFN1
019 033 168 MOVEM TT,SGAEXT
020 030 004 MOVE R,USN
021 033 167 MOVEM R,SGAPPN
022 030 009 MOVE R,UTIN
023 033 164 MOVEM R,SGADEV
024 ] ;END OF IFE QIO
025 002 029 Q$ WARN [.SHR FILE NAMES IN SAIL NEWIO?]
026 116 010 PUSHJ P,SAVHGH ;SAVE HIGH SEGMENT
027 115 002 Q% FAC [FAILED TO SAVE HIGH SEGMENT - SUSPEND!]
028 116 010 Q$ WARN [USE AN IOJRST HERE AFTER SAVHGH]
029 ] ;END OF IFN SAIL
030 SUSP0C: POP P,A ;POP FIRST ARGUMENT
031 113 019 PUSHJ P,VALSTR ;PROCESS IT INTO THE MACOUT BUFFER
032 SUSP0:
033 002 048 IFE QIO,[
034 131 052 SETZ A,
035 115 053 MOVEI T,SUSCHS
036 115 069 SUSP11: JUMPE T,SUSP12
037 115 044 MOVE B,SUSTBL-1(T)
038 SKIPN (B)
039 115 036 SOJA T,SUSP11
040 HLRZS B
041 073 009 PUSHJ P,XCONS
042 115 036 SOJA T,SUSP11
043
044 SUSTBL:
045 030 008 QUREAD,,UTIOPD
046 030 007 QUWRITE,,UTOOPD
047 IT$ QPRINT,,LPTOPD
048 002 039 IFN MOBIOF,[
049 IRP X,,[IMX,OMX,IPL,DIS,NVD,BVD]Y,,[IMPX,OMPX,PLOT,DISPLAY,NVFIX,NVID]
050 035 008 Q!Y,,X!OPD
051 TERMIN
052 ] ;END OF IFN MOBIOF
053 115 044 SUSCHS==.-SUSTBL
VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 115.1
054
055 ] ;END OF IFE QIO
056 002 048 IFN QIO,[
057 131 052 SETZ A,
058 017 016 MOVEI T,LCHNTB
059 115 069 SUSP11: SOJE T,SUSP12
060 017 019 SKIPE B,CHNTB(T)
061 CAMN B,V%TYI
062 115 036 JRST SUSP11
063 CAME B,V%TYO
064 073 009 PUSHJ P,XCONS
065 115 036 JRST SUSP11
066 ] ;END OF IFN QIO
067
068
069 SUSP12: JUMPN A,SUSPE
070 002 048 IFN QIO,[
071 HRRZ A,V%TYI ;CLOSE THE TTYS LAST, SO THEY WONT CAUSE
072 PUSHJ P,$CLOSE ;SPURIOUS "CANT SUSPEND -I/O IN PROGRESS"
073 HRRZ A,V%TYO
074 PUSHJ P,$CLOSE
075 ] ;END OF IFN QIO
076 015 019 SUSP1: HRROS NOQUIT
077 024 061 MOVEM NIL,GCNASV+1
078 024 061 MOVE T,[FREEAC,,GCNASV+2]
079 024 061 BLT T,GCNASV+2+17-FREEAC
080 032 051 SETOM NOPFLS
081 002 026 IFN ITS,[
082 002 048 IFN USELESS*QIO,[
083 015 046 MOVE T,IMASK
084 TRNN T,%PIMAR
085 115 088 JRST SUSP14
086 020 056 .SUSET [.RMARA,,SAVMAR]
087 064 009 .SUSET [.SMARA,,R70]
088 SUSP14:
089 ] ;END OF IFN USELESS*QIO
090 030 002 .SUSET [.SSNAM,,IUSN]
091 115 128 MOVEI T,SUSP3
092 011 065 EXCH T,LISPSW
093 024 061 MOVEM T,GCNASV
094 022 018 MOVEI T,MACOUT
095 SKIPN (T)
096 115 002 MOVEI T,[ASCIZ \:}SUSPENDED}
097 \]
098 032 053 SETOM SAWSP
099 .VALUE (T)
100 039 037 JRST LISPGO
101 ] ;END OF IFN ITS
102 005 005 IFN D10,[
103 HRRZ T,.JBSA"
104 HRL T,.JBREN"
105 024 061 MOVEM T,GCNASV
106 115 128 MOVEI T,SUSP3
VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 115.2
107 033 103 HRRM T,RETHGH
108 OUTSTR [ASCIZ \
109 :$SUSPENDED$
110 \]
111 002 029 IFN SAIL,[
112 022 018 SKIPN MACOUT
113 115 123 JRST SUSP68
114 131 052 SETZ T,
115 022 018 MOVE TT,[440700,,MACOUT] ;THIS PIECE OF CRAP LOOKS LIKE
116 181 046 ILDB D,TT ; SOMETHING RPG WOULD WRITE (BUT GLS DID)
117 181 046 JUMPN D,.-1
118 181 046 MOVEI D,15 ;CRUFTY STRAY 15 MAKES PTLOAD HAPPIER
119 181 046 DPB D,TT
120 IDPB T,TT
121 022 018 MOVE TT,[440700,,MACOUT]
122 PTLOAD T ;LOAD THE FIRST ARG INTO THE LINE EDITOR
123 SUSP68:
124 ] ;END OF IFN SAIL
125 033 007 JRST KILHGH
126 ] ;END OF IFN D10
127 ;HERE ON STARTUP AGAIN AFTER SUSPENSION
128 024 061 SUSP3: MOVE NIL,GCNASV+1 ;RESTORE IMPORTANT AC'S
129 024 061 MOVE T,[GCNASV+2,,FREEAC]
130 BLT T,17
131 SETZB A,B ;CLEAR OUT GARBAGE
132 035 006 SETZB C,AR1
133 131 052 SETZ AR2A,
134 002 026 IFN ITS,[
135 024 061 MOVE T,GCNASV
136 011 065 MOVEM T,LISPSW
137 221 092 JSP T,SHAREP
138 002 048 IFE QIO,[
139 064 009 .SUSET [.SDF1,,R70]
140 064 009 .SUSET [.SDF2,,R70]
141 015 046 .SUSET [.SMASK,,IMASK]
142 ] ;END OF IFE QIO
143 002 048 IFN QIO,[
144 .SUSET [.ROPTION,,TT]
145 TLO TT,OPTINT+OPTOPC ;NEW-STYLE INTERRUPTS AND NO PC SCREWAGE
146 .SUSET [.SOPTION,,TT]
147 064 009 .SUSET [.SDF1,,R70]
148 064 009 .SUSET [.SDF2,,R70]
149 015 046 .SUSET [.SMASK,,IMASK]
150 015 047 .SUSET [.SMSK2,,IMASK2]
151 002 051 IFN USELESS,[
152 015 046 MOVE T,IMASK
153 TRNE T,%PIMAR
154 020 056 .SUSET [.SMARA,,SAVMAR]
155 ] ;END OF IFN USELESS
156 ] ;END OF IFN QIO
157 ] ;END OF IFN ITS
158 005 005 IFN D10,[
159 024 061 MOVE T,GCNASV
VALRET, QUIT, AND SUSPEND FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 115.3
160 HRRM T,.JBSA"
161 HLRM T,.JBREN"
162 MOVEI T,630000
163 APRENB T,
164 GETPPN T,
165 JFCL
166 030 004 MOVEM T,USN
167 045 030 PUSHJ P,SIXJBN
168 ] ;END OF IFN D10
169 032 051 SETZM NOPFLS
170 015 019 HRRZS NOQUIT
171 002 048 IFN QIO,[
172 030 002 MOVE TT,IUSN ;IUSN WAS SET UP BY LISPGO
173 018 027 MOVEM TT,TTYIF2+F.SNM
174 018 027 MOVEM TT,TTYOF2+F.SNM
175 PUSH FXP,TT
176 PUSHJ P,OPNTTY ;*** TEMP CROCK?
177 JFCL
178 064 009 PUSH FXP,R70
179 MOVEI A,-1(FXP)
180 HRLI A,440600
181 ] ;END OF IFN QIO
182 002 048 IFN ITS*<QIO-1>,[
183 .SUSET [.RSNAM,,TT]
184 030 002 MOVEM TT,IUSN
185 030 004 MOVEM TT,USN
186 221 011 PUSHJ P,TTYOPN
187 030 004 MOVE A,[440600,,USN]
188 ] ;END OF IFN ITS*<QIO-1>
189 IT$ PUSHJ P,READ6C
190 SA% 10$ PUSHJ P,SUNAME
191 131 052 SA$ SETZ D,
192 181 046 SA$ DSKPPN D,
193 SA$ PUSHJ P,SUNM2
194 064 009 Q$ SUB FXP,R70+2
195 MOVEM A,SUDIR
196 MOVEI A,Q. ;VALUE IS *
197 POPJ P,
HIGH SEGMENT SAVE ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 116
001
002 SUBTTL HIGH SEGMENT SAVE ROUTINE
003
004 005 005 IFN D10,[
005
006 ;;; THE RELEVANT FILE NAMES ARE IN SGADEV, SGAPPN, SGAEXT.
007 ;;; THE MAIN FILE NAME IS PASSED THROUGH T, AND STORED INTO
008 ;;; SGANAM ON SUCCESS. SKIP RETURN ON SUCCESS.
009
010 SAVHGH: LOCKI ;LOCK OUT INTERRUPTS AROUND USE OF TEMP CHANNEL
011 002 029 IFN SAIL,[
012 PUSH FXP,T
013 SKIPL .JBHRL ;IS HISEG CURRENTLY WRITE-PROTECTED?
014 116 038 JRST SAPWIN ;NO, MUST PREVIOUSLY HAVE UNPURIFIED IT
015 039 006 SKIPN PSGNAM
016 209 011 JRST FASLUH
017 MOVEI T,.IODMP
018 039 007 MOVE TT,PSGDEV
019 131 052 SETZ D,
020 017 021 OPEN TMPC,T ;OPEN UP .SHR FILE DEVICE IN DUMP MODE
021 209 011 JRST FASLUH
022 039 006 MOVE T,PSGNAM
023 039 008 MOVE TT,PSGEXT
024 131 052 SETZ D,
025 039 009 MOVE R,PSGPPN
026 017 021 LOOKUP TMPC,T
027 209 011 JRST FASLUR
028 071 024 MOVS T,R
029 MOVNS T ;T GETS LENGTH OF .SHR FILE
030 ADDI T,400000-1
031 033 181 PUSHJ P,LDRIHS ;GO READ IN HIGH SEGMENT (FROM WITHIN LOSEG!)
032
033 017 021 RELEASE TMPC, ;FLUSH TEMP CHANNEL
034 030 020 MOVE T,D10NAM ;USE D10NAM AS HISEG NAME TO FOIL GETHGH IN OTHER JOBS
035 LSH T,-6 ;AS LONG AS WE'RE BEING RANDOM...
036 SETNM2 T, ;TRY TO SET NAME FOR HIGH SEGMENT
037 JFCL
038 SAPWIN:
039 ] ;END OF IFN SAIL
040 033 161 SETZM SGANAM
041 002 029 IFN SAIL,[
042 ;;;SAVE VALIDATION WORDS IN HISEG, HOPE THAT HISEG WRITEABLE
043 033 168 MOVE D,SGAEXT
044 039 008 MOVEM D,PSGEXT
045 033 167 MOVE D,SGAPPN
046 039 009 MOVEM D,PSGPPN
047 181 046 MOVEI D,.IODMP
048 033 164 MOVE R,SGADEV
049 039 007 MOVEM R,PSGDEV
050 131 052 SETZ F,
051 017 021 OPEN TMPC,D
052 UNLKPOPJ
053 033 168 MOVE TT,SGAEXT
HIGH SEGMENT SAVE ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 116.1
054 131 052 SETZ D,
055 033 167 MOVE R,SGAPPN
056 POP FXP,T
057 039 006 MOVEM T,PSGNAM
058 017 021 ENTER TMPC,T
059 UNLKPOPJ
060 MOVEI TT,400000-1 ;MAKE UP IOWD
061 SUB TT,.JBHRL
062 MOVSS TT
063 HRRI TT,400000-1
064 131 052 SETZ D,
065 017 021 OUT TMPC,TT ;OUTPUT THE HISEG
066 CAIA
067 UNLKPOPJ
068 017 021 CLOSE TMPC, ;FLUSH TEMP CHANNEL
069 017 021 RELEASE TMPC,
070 033 161 MOVEM T,SGANAM ;WE CAREFULLY DO NOT STORE SGANAM UNTIL
071 UNLOCKI ; WE HAVE CLEARLY WON (MORE OR LESS)
072 059 039 JRST POPJ1
073
074 ] ;END OF IFN SAIL
075
076 ] ;END OF IFN D10
ARGS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 117
001
002 SUBTTL ARGS FUNCTION
003
004 057 027 ARGS: JSP TT,LWNACK ;LSUBR (1 . 2) - USES A,B,C,T,TT,D,R,F
005 LA12,,QARGS
006 218 051 JSP R,PDLA2(T) ;SPREAD ARGS
007 ARGS1: SKOTT A,SY
008 117 059 JRST ARGS0 ;FIRST ARG MUST BE SYMBOL
009 HLRZ F,(A)
010 117 027 ARGS1A: AOJL T,ARGS3 ;TWO ARGS
011 071 024 HLRZ R,1(F) ;JUST WANT TO GET PRESENT ARGS PROP
012 081 044 ARGSCU: JUMPE R,FALSE ;ARGS CONS-UP
013 071 024 IDIVI R,1000
014 SKIPN B,F
015 117 019 JRST ARGSC1
016 MOVEI TT,-1(F)
017 074 008 JSP T,FIX1A
018 MOVEI B,(A)
019 071 024 ARGSC1: SKIPN A,R
020 073 010 JRST CONS
021 071 024 MOVEI TT,(R)
022 CAIE TT,777
023 SUBI TT,1
024 074 008 JSP T,FIX1A
025 073 010 JRST CONS
026
027 059 031 ARGS3: JUMPE A,CPOPJ
028 117 037 JUMPN B,ARGS5
029 071 024 HLRZ R,1(F) ;JUST WANT TO FLUSH ARGS PROP
030 081 044 JUMPE R,FALSE
031 131 052 SETZ R,
032 PUSH P,A
033 117 054 JSP D,ARGCLB
034 064 009 SUB P,R70+1
035 086 011 JRST TRUE
036
037 ARGS5: PUSH P,A
038 071 024 SETZB TT,R
039 035 006 HLRZ C,(B) ;MUMBLE MUMBLE - MUST FIGURE
040 117 045 JUMPE C,ARGS6 ; OUT WHATEVER WE WERE HANDED
041 065 007 JSP T,FXNV3
042 071 024 CAIE R,777
043 071 024 ADDI R,1
044 071 024 LSH R,11
045 ARGS6: HRRZ A,(B)
046 065 007 JSP T,FXNV1
047 CAIE TT,777
048 ADDI TT,1
049 071 024 ADDI R,(TT)
050 HLRZ TT,1(F) ;LOOK AT ARGS PROP ALREADY THERE
051 071 024 CAIN TT,(R) ;IF ALREADY WHAT WE WANT, JUST EXIT,
052 059 035 JRST POPAJ ; THEREBY AVOIDING A PURE PAGE TRAP
053 059 035 MOVEI D,POPAJ ;FAKE OUT A JSP D,
ARGS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 117.1
054 ARGCLB: MOVEI B,(F) ;CLOBBER IN AN ARGS PROPERTY
055 ARGCL3:
056 071 024 PURTRAP ARGCL7,B, HRLM R,1(B) ;MAY HAVE TO FUSS ABOUT PURE PAGE TRAP
057 209 011 JRST (D)
058
059 039 025 ARGS0: MOVEI F,$$$NIL
060 117 010 JUMPE A,ARGS1A
061 117 004 WTA [ NON-SYMBOL - ARGS!]
062 117 007 JRST ARGS1
EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 118
001
002 SUBTTL EVALFRAME FUNCTION, GTPDLP, AND FRETURN
003
004 EVALFRAME:
005 119 002 SKIPA R,[GTPDLP] ;THIS ENTRY CAUSES INTERPRETATION OF ARG AS PDLPOINTER
006 119 023 FRM2A: MOVEI R,GTPDL2 ;THIS ENTRY, TO ALLOW CONTINUING FROM WHERE D CURRENTLY IS
007 071 024 JSP R,(R)
008 061 005 $EVALFRAME ;GET EVALFRAME OR APPLYFRAME JUST PRIOR TO
009 061 044 $APPLYFRAME ; POINT ON PDL MARKED BY ARG
010 081 044 JRST FALSE
011 064 009 FRM3: SUB D,R70+1 ;DEFINE A FRAME POINTER TO BE JUST BELOW THE EVALFRAME MARKER
012 181 046 HRRZ TT,(D)
013 118 019 JUMPN F,FRM3A ;F IS INDEX OF WHICH KIND OF FRAME
014 MOVEI T,(TT)
015 005 042 LSH T,-SEGLOG
016 036 033 SKIPL ST(T)
017 118 021 JRST FRM4A
018 HLRZ TT,(TT)
019 FRM3A: CAIN TT,QEVALFRAME ;DONT ALLOW THE CALL TO EVALFRAME
020 118 063 JRST FRM2B ; ITSELF TO BE OUTPUT
021 181 046 FRM4A: PUSH P,(D)
022 FRM4: ;ERRFRAME COMES HERE
023 181 046 HLRO TT,(D) ;ONE LEFT HALF'S AS GOOD AS ANOTHER...
024 074 008 JSP T,FIX1A ;MAKE UP PREVIOUS SPECIAL PDL POINTER
025 051 010 PUSHJ P,ACONS
026 EXCH B,(P)
027 181 046 MOVE TT,1(D)
028 061 044 CAME TT,[$APPLYFRAME]
029 118 049 JRST FRM8
030 PUSH P,A
031 PUSH P,B
032 061 044 MOVE T,-2(D) .SEE $APPLYFRAME ;BECAUSE THERE IS A DISCUSSION
033 118 039 JUMPL T,FRM5 ; OF THE FRAME FORMAT THERE
034 MOVEI A,(T)
035 TLCN T,-1 ;THINK ABOUT THIS WHEN YOU LOOK!
036 118 044 JRST FRM7
037 HLRS T ;SUBTLE WAY TO GET NEGATION
038 181 046 ADDI T,(D)
039 131 052 FRM5: SETZ A,
040 FRM5A: HRRZ B,(T)
041 073 009 PUSHJ P,XCONS
042 118 040 AOBJN T,FRM5A
043 089 055 PUSHJ P,NREVERSE
044 051 010 FRM7: PUSHJ P,ACONS
045 POP P,B
046 073 009 PUSHJ P,XCONS
047 MOVEI B,(A)
048 POP P,A
049 073 009 FRM8: PUSHJ P,XCONS
050 MOVE B,A ;OUTPUT 4-LIST: "EVAL" OR "APPLY" OR "ERR" [A SYMBOL]
051 181 046 HRROI TT,(D) ; FRAME (REGPDL) POINTER [A FIXNUM]
052 074 008 JSP T,FIX1A ; <FORM> [EVAL] OR (<FN> <ARGS>) [APPLY]
053 073 010 PUSHJ P,CONS ; OR <MSG-FORM> [ERR]
EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 118.1
054 181 046 MOVE TT,1(D) ; ALIST (SPECPDL) POINTER [A FIXNUM]
055 MOVEI B,QOEVAL
056 061 044 CAMN TT,[$APPLYFRAME]
057 MOVEI B,QAPPLY
058 061 004 CAMN TT,[$ERRFRAME]
059 MOVEI B,QERR
060 073 009 PUSHJ P,XCONS
061 050 031 JRST POPBJ
062
063 071 024 FRM2B: TLNE R,1
064 064 009 ADD D,R70+2 ;WHEN SEARCHING FORWARD, SKIP OVER CALL
065 118 006 JRST FRM2A ;TO EVALFRAME
EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 119
001
002 GTPDLP: ;CALLED BY JSP R,GTPDLP; RETURNS PDL PTR IN D
003 181 046 MOVEI D,(P)
004 119 023 JUMPE A,GTPDL2 ;ARG=NIL => START SEARCH FROM CURRENT PDL POS
005 065 007 JSP T,FXNV1 ;NOTE: EVALFRAME LOOKS AT BIT 3.1 OF R
006 119 012 JUMPL TT,GTPDL5 ;BIT 3.1 OF R = 0 WHEN SEARCHING BACK THE PDL
007 071 024 TLO R,1 ;BIT 3.1 OF R = 1 WHEN SEARCHING FORWARD
008 MOVNS TT ;WANT TO SKIP OVER THE FRAME MARKER WHEN
009 SKIPN TT ; SEARCHING FORWARD (SINCE A PDLPOINTER WILL
010 027 061 SKIPA TT,C2 ; BE POINTING TO ONE BELOW A FRAME MARKER)
011 064 009 ADD TT,R70+2
012 GTPDL5: TLZ TT,-1
013 027 061 HRRZ T,C2
014 CAIGE TT,(T)
015 209 011 JRST GTPDL1
016 MOVEI T,(P)
017 SUBI T,(TT)
018 JUMPLE T,GTPDL1
019 MOVEI T,(TT)
020 CAIL T,(P)
021 MOVE TT,P
022 181 046 HRROI D,(TT)
023 071 024 GTPDL2: MOVE TT,(R) ;KEY ON WHICH TO SEARCH
024 071 024 JUMPE TT,2(R) ;MATCH 0 => NO SEARCH, JUST GIVE OUT PDL PTR
025 071 024 MOVE F,1(R) ;WELL, IT'S POSSIBLE TO SEARCH FOR TWO THINGS
026 071 024 TLNE R,1
027 119 037 JRST GTPDL4
028 027 061 HRRZ T,C2
029 181 046 GTPDL3: CAIL T,(D) ;A BACK SEARCH
030 209 011 JRST 2(R) ;SEARCHED-AND-FAILED EXIT
031 181 046 CAMN TT,(D)
032 119 047 JRST GTPX0
033 181 046 CAMN F,(D)
034 119 048 JRST GTPX1
035 119 029 SOJA D,GTPDL3
036
037 GTPDL4: MOVEI T,(P)
038 181 046 GTP4A: CAMN TT,(D)
039 119 047 JRST GTPX0
040 181 046 CAMN F,(D)
041 119 048 JRST GTPX1
042 181 046 CAIG T,(D)
043 209 011 JRST 2(R) ;FAILURE
044 119 038 AOJA D,GTP4A
045
046
047 GTPX0: TDZA F,F
048 GTPX1: MOVEI F,1
049 209 011 JRST 3(R)
EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 120
001
002 035 006 FRETURN: MOVE C,B
003 119 002 JSP R,GTPDLP
004 0
005 JFCL
006 181 046 MOVEI F,(D)
007 061 005 MOVE TT,[$EVALFRAME]
008 CAMN TT,1(F)
009 120 013 JRST FRETR1
010 061 044 MOVE TT,[$APPLYFRAME]
011 CAME TT,1(F)
012 209 011 JRST FRERR
013 181 046 FRETR1: MOVEI D,(F)
014 181 046 SUBI D,(P)
015 181 046 HRLI D,(D)
016 181 046 HRRI D,(F)
017 061 007 MOVE TT,[$UIFRAME]
018 181 046 CAME TT,(D) ;SEARCH FOR A USER INTERRUPT FRAME
019 181 046 AOBJN D,.-1
020 181 046 CAMN TT,(D)
021 058 003 JSP TT,UIBRK
022 020 031 FRP1: SKIPE T,PA4 ;BREAK UP A DOMINEERING PROG
023 CAIL F,(T) ;[WHICH BREAKS UP INTERIOR ERRSETS AND CATCHES]
024 120 029 JRST FRP2
025 120 022 MOVEI TT,FRP1-1 ;FAKE OUT RETURN BY INSERTING A RETURN-ADDRESS
026 166 019 MOVEM TT,-LPRP+1(T) ;OF FRP1 ON THE PDL
027 166 064 JRST RETURN
028
029 020 028 FRP2: SKIPN B,ERRTN ;BREAK UP A DOMINEERING ERRSET OR CATCH
030 020 029 SKIPE B,CATRTN
031 FRP2A: CAIL F,(B)
032 120 036 JRST FRP3
033 120 022 MOVEI TT,FRP1
034 171 033 JRST BKRST0
035
036 020 030 FRP3: SKIPN B,EOFRTN ;BREAK OUT OF ANY E-O-F SET READS
037 120 040 JRST FRP3QA
038 CAIGE F,(B)
039 120 031 JRST FRP2A
040 035 006 FRP3QA: MOVE A,C
041 005 005 IFN D10,[
042 ADDI F,1 ;FIX UP PDL POINTERS
043 027 061 SUB F,C2
044 HRLS F
045 027 061 ADD F,C2
046 MOVE P,F
047 HLRZ F,-2(P)
048 027 063 SUB F,FXC2
049 HRLS F
050 027 063 ADD F,FXC2
051 MOVE FXP,F
052 HRRZ F,-2(P)
053 027 062 SUB F,FLC2
EVALFRAME FUNCTION, GTPDLP, AND FRETURN LISP.393[MAC,LSP] 01/17/78 Page 120.1
054 HRLS F
055 027 062 ADD F,FLC2
056 MOVE FLP,F
057 ] ;END OF IFN D10
058 .ELSE,[ ;IN A PAGED SYSTEM, THE PDLOV HANDLER
059 HRROI P,1(F) ; WILL FIX UP THE LHS OF THE PDL PTRS
060 HLRO FLP,-2(P)
061 HRRO FXP,-2(P)
062 ] ;END OF .ELSE
063 HLRZ TT,-1(P)
064 049 005 JRST UBD ;UNBIND TO MARKED POINT, AND POP FRAME
GETCHAR, GETCHARN, AND SUBLIS LISP.393[MAC,LSP] 01/17/78 Page 121
001
002 SUBTTL GETCHAR, GETCHARN, AND SUBLIS
003
004 064 007 $GETCHARN: PUSH P,CFIX1 ;SUBR 2 - NCALLABLE
005 059 031 SKIPA F,[ZPOPJ,,CPOPJ]
006 081 044 GETCHAR: MOVE F,[FALSE,,RDCH2] ;SUBR 2
007 SKIPE V.RSET
008 121 023 JRST GETCH8
009 181 046 MOVE D,(B)
010 082 050 PUSHJ P,PNGT0
011 181 046 GETCH1: SOJL D,(F)
012 181 046 IDIVI D,5 ;(Q,R) QUOTIENT,REMAINDER IN D,R
013 121 017 SOJL D,GETCH3
014 GETCH2: HRRZ A,(A) ;CDR BY Q WORDS
015 121 014 SOJGE D,GETCH2 ;RECALL THAT (CDR NIL) = NIL
016 121 020 JUMPE A,GETCH4
017 GETCH3: HLRZ A,(A)
018 121 027 LDB TT,GTCTB(R)
019 JUMPN TT,(F)
020 GETCH4: MOVS F,F
021 209 011 JRST (F)
022
023 065 007 GETCH8: JSP T,FXNV2
024 082 048 PUSHJ P,PNGET
025 121 011 JRST GETCH1
026
027 GTCTB: 350700,,(A)
028 260700,,(A)
029 170700,,(A)
030 100700,,(A)
031 010700,,(A)
032
033
034 SUBLIS: PUSH P,A ;USES ONLY A,B,T,TT,D,R
035 PUSH P,B
036 181 046 MOVE D,A
037 015 019 HLLOS NOQUIT ;MOBY DELAYED QUIT FEATURE
038 122 002 SUBL1: JUMPE D,SUBL2
039 181 046 HLRZ T,(D) ;A SUBSTITUTION LIST IS LIKE
040 HLRZ B,(T) ;((U1 . S1) (U2 . S2) . . .)
041 SKOTT B,SY
042 121 060 JRST SUBLOSE
043 SUBL1B: HRRZ A,(B) ;SEXPRESSION S IS SUBSTITUTED FOR ATOM U
044 HLRZ A,(A)
045 CAIN A,QSUBLIS
046 121 054 JRST SUBL1A
047 HRRZ A,(T)
048 MOVEM B,T
049 HRRZ B,(B)
050 073 010 PUSHJ P,CONS
051 MOVEI B,QSUBLIS ;PUT "SUBLIS" PROPERTY ONTO THOSE ATOMS U IN THE
052 073 009 PUSHJ P,XCONS ;SUBSTITUTION LIST ((U1 . V1) . . . (UN . VN))
053 HRRM A,(T)
GETCHAR, GETCHARN, AND SUBLIS LISP.393[MAC,LSP] 01/17/78 Page 121.1
054 181 046 SUBL1A: HRRZ D,(D)
055 015 012 MOVE T,INTFLG
056 121 038 AOJGE T,SUBL1 ;0=> NO INT, -1=> USER INT, -2,-3=> QUIT
057 071 024 MOVE R,D
058 121 065 JRST SUBL3Q
059
060 121 067 SUBLOSE: JUMPE B,SUBL3Z
061 MOVEI A,(B)
062 071 024 MOVEI R,(D)
063 121 034 MOVEI T,[LER3 [SIXBIT \NON-ATOMIC ITEM - SUBLIS!\]]
064 MOVEM T,-2(P)
065 064 009 SUBL3Q: SUB P,R70+1
066 122 006 JRST SUBL3A
067 SUBL3Z: MOVEI B,NILPROPS
068 121 043 JRST SUBL1B
GETCHAR, GETCHARN, AND SUBLIS LISP.393[MAC,LSP] 01/17/78 Page 122
001
002 SUBL2: POP P,A
003 122 024 PUSHJ P,SBL1
004 JFCL
005 071 024 MOVEI R,0 ;REMOVE ALL "SUBLIS" PROPERTIES
006 SUBL3A: MOVE TT,(P)
007 071 024 SUBL3: CAIN R,(TT) ;REMOVE "SUBLIS" PROPERTY
008 122 021 JRST SUBL4
009 HLRZ T,(TT)
010 HLRZ T,(T)
011 JUMPN T,.+2
012 MOVEI T,NILPROPS
013 HRRZ B,(T)
014 MOVE B,(B)
015 181 046 HLRZ D,B
016 HRRZ B,(B)
017 181 046 CAIN D,QSUBLIS
018 HRRM B,(T)
019 HRRZ TT,(TT)
020 122 007 JRST SUBL3
021 064 009 SUBL4: SUB P,R70+1
022 209 011 JRST CZECHI
023
024 SBL1: SKOTT A,LS ;TRACE THROUGH STRUCTURE IN (A) SUBSTITUTING
025 122 043 JRST SBL2 ;(GET 'U 'SUBLIS) FOR U WHEREVER IT IS NON-NIL
026 PUSH P,A
027 HLRZ A,(A)
028 122 024 PUSHJ P,SBL1
029 122 038 JRST SBL4
030 EXCH A,(P)
031 HRRZ A,(A)
032 122 024 PUSHJ P,SBL1
033 JFCL
034 HRRZ B,(P)
035 064 009 SBL5: SUB P,R70+1
036 073 009 PUSHJ P,XCONS
037 059 039 JRST POPJ1
038 SBL4: HRRZ A,@(P)
039 122 024 PUSHJ P,SBL1
040 059 035 JRST POPAJ
041 HLRZ B,@(P)
042 122 035 JRST SBL5
043 SBL2: TLNN TT,SY
044 122 053 JRST SBL2B
045 HRRZ B,(A)
046 SBL2A: HLRZ T,(B)
047 CAIE T,QSUBLIS
048 POPJ P,
049 HRRZ A,(B)
050 HLRZ A,(A)
051 059 039 JRST POPJ1
052
053 059 031 SBL2B: JUMPN A,CPOPJ
GETCHAR, GETCHARN, AND SUBLIS LISP.393[MAC,LSP] 01/17/78 Page 122.1
054 HRRZ B,NILPROPS
055 122 046 JRST SBL2A
SAMEPNAMEP AND ALPHALESSP LISP.393[MAC,LSP] 01/17/78 Page 123
001
002 SUBTTL SAMEPNAMEP AND ALPHALESSP
003
004 181 046 SAMEPNAMEP: TDZA D,D ;USES ONLY A,B,T,TT,D
005 181 046 ALPHALESSP: MOVEI D,TRUTH ;MUST PRESERVE C,AR1,AR2A,R,F (SEE SORT)
006 PUSH P,B
007 082 048 PUSHJ P,PNGET
008 EXCH A,(P)
009 082 048 PUSHJ P,PNGET
010 POP P,B ;FROM NOW ON, A HAS PNAME OF 2ND ARG, B OF 1ST!!!
011 123 014 JRST ALPLP1
012 ALPL3: HRRZ A,(A)
013 HRRZ B,(B)
014 123 028 ALPLP1: JUMPE B,ALPL2
015 081 044 JUMPE A,FALSE ;ON SAMEPN, LOSE IF 2ND ARG RUNS OUT BEFORE 1ST
016 HLRZ T,(A) ;ON ALPHAL, LOSE IF 2ND ARG IS SHORTER THAN 1ST
017 MOVE T,(T)
018 HLRZ TT,(B) ;FOR SAMEPN, WILL RETURN NIL IF TWO ARE UNEQUAL IN SOME PLACE
019 CAMN T,(TT) ;NO INFO IF CORRESPONDING PLACES ARE EQUAL
020 123 012 JRST ALPL3
021 081 044 JUMPE D,FALSE ;BUT NOT EQUAL IN SAMENAMEP MEANS LOSE
022 MOVE TT,(TT) ;MUST DO SOME HAIR FOR THE ALPHALESSP
023 LSHC T,-1 ; COMPARE TO WIN, SINCE PNAME WORDS ARE
024 CAMG T,TT ; LOGICAL DATA, NOT ARITHMETIC
025 081 044 JRST FALSE ;2ND ARG STRICTLY LESS THAN FIRST
026 086 011 JRST TRUE ;2ND ARG STRICTLY GREATER THAN FIRST
027
028 181 046 ALPL2: EXCH A,D
029 086 009 JUMPE D,NOT ;IF ALPHAL, WIN WHEN A NON-NUL [FOR 1ST ARG IS PROPER SUBSTRING OF 2ND]
030 POPJ P, ;IF SAMEPN, WIN WHEN A NUL [FOR CORRESPONDENTS HAVE BEEN EQUAL ALL ALONG]
031
032
033 SYSP: MOVEI B,TRUTH ;SUBR 1 - DETERMINE WHETHER SYMBOL HAS
034 SYSP3:
035 10% CAIGE A,BEGFUN ; A "SYSTEM" SUBR PROPERTY
036 219 074 10$ CAIL A,ENDFUN
037 081 044 JRST FALSE
038 219 074 10% CAIG A,ENDFUN
039 10$ CAIL A,BEGFUN
040 084 033 JRST BRETJ
041 CAIGE A,BSYSAR ; ... OR MAYBE A SYSTEM ARRAY PROPERTY
042 123 052 JRST SYSP6
043 CAIGE A,ESYSAR
044 084 033 JRST BRETJ ;RETURNS T FOR SUBR/SAR POINTERS
045 CAIE B,QAUTOLOAD
046 123 052 JRST SYSP6
047 CAIL A,BSYSAP
048 CAIL A,ESYSAP
049 081 044 JRST FALSE
050 084 033 JRST BRETJ
051
052 080 013 SYSP6: JSP T,SPATOM ;RETURNS FALSE FOR NON-SYMBOLS
053 081 044 JRST FALSE
SAMEPNAMEP AND ALPHALESSP LISP.393[MAC,LSP] 01/17/78 Page 123.1
054 MOVEI B,ASBRL
055 083 020 PUSHJ P,GETL1
056 059 031 JUMPE A,CPOPJ ;RETURNS FALSE FOR SYMBOLS WITH NO FN PROPS
057 HLRZ B,(A) ;RETURNS NAME OF PROPERTY OF ONE IS FOUND,
058 070 015 JSP T,%CADR
059 123 034 JRST SYSP3 ; AND THE PROPERTY VALUE PASSES THE SYSP TEST
060
061 123 066 GCTWA: JUMPE A,GCTWI
062 HLRZ A,(A)
063 086 005 PUSHJ P,NOTNOT
064 MOVEM A,VGCTWA
065 123 067 JRST GCTWX
066 024 072 GCTWI: SETOM IRMVF
067 GCTWX: MOVEI A,IN0
068 024 072 SKIPGE IRMVF
069 ADDI A,1
070 SKIPE VGCTWA
071 ADDI A,10
072 POPJ P,
COPYSYMBOL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 124
001
002 SUBTTL COPYSYMBOL FUNCTION
003
004 059 031 COPYSYMBOL: JUMPE A,CPOPJ
005 080 013 JSP T,SPATOM
006 JSP T,PNGE
007 124 011 JUMPN B,CPSY0
008 082 050 CPSY: PUSHJ P,PNGT0
009 072 013 JRST SYCONS
010
011 CPSY0: PUSH P,A
012 124 008 PUSHJ P,CPSY
013 EXCH A,(P)
014 PUSH P,A
015 HRRZ A,(A)
016 059 034 JUMPE A,S1PAJ
017 MOVEI B,NIL
018 060 007 PUSHJ FXP,SAV5M3
019 089 030 PUSHJ P,.APPEND
020 060 032 PUSHJ FXP,RST5M3
021 HRRM A,@-1(P)
022 HLRZ A,@(P)
023 HLRZ T,1(A) ;ARGS PROPERTY
024 JUMPE T,.+3
025 HLRZ TT,@-1(P)
026 HRLM T,1(TT)
027 HRRZ A,@(A)
028 CAIN A,QUNBOUND
029 059 034 JRST S1PAJ
030 EXCH AR1,-1(P)
031 057 006 JSP T,.SET
032 EXCH AR1,-1(P)
033 059 034 JRST S1PAJ
SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 125
001
002 SUBTTL SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS
003
004 ;ARGS ARE CHAR (AS NUMBER OR ATOM), SYNTAX-CODE, MACRO-OR-TRANSLATION
005
006 131 052 SETSYNTAX: SETZ AR1, ;SUBR 3
007 MOVEI AR2A,(B)
008 080 013 JSP T,SPATOM
009 125 012 JRST RSSYN1
010 107 050 JSP T,CHNV1
011 074 008 JSP T,FIX1A
012 RSSYN1: CAIN AR2A,QMACRO
013 125 017 JRST RSSYN2
014 CAIE AR2A,QSPLICING
015 125 022 JRST RSSYN3
016 MOVEI AR1,[QSPLICING,,NIL]
017 RSSYN2: MOVE B,A
018 125 046 PUSH P,CTRUE
019 PUSH P,AR1
020 127 011 JRST SSMC43
021
022 RSSYN3: MOVSI AR1,40000 ;WAY TO FAKE OUT SSYN0
023 MOVEI B,(A)
024 125 031 JUMPE C,RSSYN5 ;SKIP IF NO CHTRAN STUFF
025 125 048 PUSHJ P,RSSYN4
026 HRRZM A,(FXP)
027 MOVEI A,(B) ;LOSING RETROFIT FOR NSTST
028 035 006 MOVEI B,(C)
029 126 002 PUSHJ P,SSCHTRAN
030 064 009 SUB FXP,R70+1
031 086 011 RSSYN5: JUMPE AR2A,TRUE ;XIT IF NO SYNTAX STUFF
032 CAIE AR2A,QSINGLE
033 125 038 JRST RSSYN7
034 NW% PUSH FXP,[600500]
035 NW$ PUSH FXP,[RS.SCS]
036 035 006 MOVEI C,(FXP)
037 125 041 JRST RSSYN8
038 035 006 RSSYN7: MOVE C,AR2A
039 125 048 PUSHJ P,RSSYN4
040 HLRZS (FXP)
041 RSSYN8:
042 MOVEI A,(B) ;LOSING RETROFIT FOR NSTAT
043 035 006 MOVEI B,(C)
044 126 005 PUSHJ P,SSSYNTAX
045 064 009 SUB FXP,R70+1
046 086 011 CTRUE: JRST TRUE
047
048 064 009 RSSYN4: PUSH FXP,R70
049 035 006 MOVEI A,(C)
050 080 013 JSP T,SPATOM
051 POPJ P,
052 035 006 MOVEI C,(B) ;SAVE B
053 107 050 JSP T,CHNV1
SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 125.1
054 MOVEI A,(TT)
055 035 006 MOVEI B,(C) ;RESTORE B
056 035 006 MOVEI C,(FXP) ;SET C TO BE FIXNUM ON TOP OF PDL
057 065 067 JSP T,RSXST
058 020 049 MOVE TT,@RSXTB
059 MOVEM TT,(FXP)
060 POPJ P,
SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 126
001
002 SSCHTRAN:
003 071 024 NW% SKIPA F,[HRRM R,(TT)]
004 071 024 NW$ SKIPA F,[DPB R,[001100+TT,,]]
005 SSSYNTAX:
006 071 024 NW% MOVSI F,(HRLM R,(TT))
007 071 024 NW$ MOVE F,[LDB R,[113300+TT,,]]
008 091 051 PUSH P,[SPROG3]
009 MOVSI AR1,40000 ;LOSING CROCK
010 SSSYN1:
011 035 006 MOVEI C,(B) ;LOSING CROCK
012 MOVEI B,(A)
013 126 026 PUSHJ P,GRCTI ;GET INDEX FOR RCT INTO D
014 TLNE AR1,40000 ;40000 BIT SAYS EVAL 3RD ARG
015 065 007 JSP T,FXNV3
016 127 061 JSP T,SMCR2 ;LOCK AND SETUP RCT ARRAY PTR INTO TT
017 181 046 ADDI TT,(D)
018 209 025 XCT F ;MAY SKIP (FOR (STATUS CHTRAN))
019 UNLKPOPJ ;MUST BE ONLY ONE INSTRUCTION.
020 NW% TLNE TT,4000 ;SKIP UNLESS MACRO CHAR
021 NW$ TLNE TT,(RS.MAC);SKIP UNLESS MACRO CHAR
022 181 046 MOVEI TT,(D) ;USE CHARACTER AS ITS OWN CHTRAN
023 TLZ TT,-1
024 UNLKPOPJ
025
026 065 007 GRCTI: JSP T,FXNV2 ;GET READTABLE INDEX
027 181 046 SA% CAIGE D,NASCII
028 181 046 SA$ CAIGE D,1010
029 059 031 JUMPGE D,CPOPJ
030 209 011 JRST GRCTIE
031
032 SMACRO:
033 MOVEI B,(A)
034 126 026 PUSHJ P,GRCTI
035 127 061 JSP T,SMCR2
036 181 046 ADD TT,D
037 SMCR1: MOVEI A,NIL
038 035 006 MOVE C,(TT)
039 UNLOCKI
040 035 006 NW% TLNN C,4000
041 035 006 NW$ TLNN C,(RS.MAC)
042 POPJ P, ;EXIT WITH NIL IF NO MACRO CHAR
043 035 006 NW% TLNE C,40
044 035 006 NW$ TRNE C,RS.ALT
045 MOVEI A,QSPLICING ;SPLICING TYPE
046 073 008 PUSHJ P,NCONS
047 035 006 NW% MOVEI B,(C)
048 NW$ PUSH P, A
049 126 059 NW$ PUSHJ P, GETMAC
050 NW$ HRRZ B, (A) ;CDR OF ASSQ IS FUNCTION
051 NW$ POP P, A
052 073 009 PUSHJ P,XCONS
053 POPJ P,
SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 126.1
054
055 002 047 IFN NEWRD,[
056 ;;;ROUTINE TO GET MACRO ENTRY. CHAR IN D.
057 ;;; CLOBBERS A, B, TT, RETURNS (CHAR . FCN) IN A
058 ;;; RSXST MUST HAVE BEEN DONE
059 GETMAC: MOVEI A, 206 ;GET FCN LIST FROM READTABLE
060 020 049 HRRZ B, @RSXTB ;..
061 181 046 MOVE A, D ;CHARACTER
062 081 042 PUSHJ P, ASSQ
063 126 063 JUMPE A, [LERR [SIXBIT/MACRO CHARACTER VANISHED#!!/]]
064 POPJ P,
065 ] ;END OF IFN NEWRD
SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 127
001
002 SSMACRO:
003 064 014 CAME T,XC-3 ;CROCK TO GET NSTAT UP FAST
004 064 009 PUSH P,R70
005 POP P,A
006 035 006 POP P,C
007 POP P,B
008 SKIPE A
009 051 010 PUSHJ P,ACONS
010 PUSH P,A
011 126 026 SSMC43: PUSHJ P,GRCTI
012 127 061 JSP T,SMCR2
013 181 046 ADD TT,D
014 021 051 HRRZM TT,RM4
015 127 064 JUMPE C,SSM1
016 035 006 NW% HRLI C,404500
017 035 006 NW$ MOVE C,[RS.CMS]
018 SKIPE A,(P)
019 127 052 JRST SSM3
020 SSM4:
021 021 051 EXCH C,@RM4
022 035 006 NW% HRRZ A,C
023 035 006 NW% TLNE C,4000
024 128 002 NW% PUSHJ P,SSGCREL ;CLOBBERS C
025 002 047 IFN NEWRD,[
026 035 006 TLNN C,(RS.MAC)
027 127 031 JRST SSM4AA
028 126 059 PUSHJ P, GETMAC
029 ;REMOVE PREVIOUS MACRO FUNCTION FROM ASSQ LIST.
030 ;**** (SETQ MAC-LIST (DELQ A MAC-LIST)) ****
031 SSM4AA: ;AND NO GCREL CRUFT NECC.
032 ]
033 021 051 MOVE C,@RM4
034 035 006 NW% HRRZ A,C
035 035 006 NW% TLNE C,4000
036 128 003 NW% PUSHJ P,SSGCPRO
037 021 051 NW% HRRM A,@RM4
038 021 051 NW$ DPB D, [001100,,@RM4] ;MACROS MUST HAVE SELF AS CHTRAN
039 181 046 NW$ MOVE B, D ;***SURELY THIS COULD BE A LOT LESS KLUDGEY***
040 073 009 NW$ PUSHJ P, XCONS
041 NW$ MOVE B, A
042 NW$ MOVEI A, 206
043 020 049 NW$ MOVE A, @RSXTB
044 073 009 NW$ PUSHJ P, XCONS
045 NW$ MOVE B, A
046 NW$ MOVEI A, 206
047 020 049 NW$ MOVEM B, @RSXTB
048 064 009 SUB P,R70+1
049 021 051 MOVE TT,RM4
050 126 037 JRST SMCR1
051
052 SSM3: MOVEI AR1,(B)
053 HLRZ A,(A)
SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 127.1
054 107 050 JSP T,CHNV1
055 CAIN TT,"S ;SPLICINGP
056 035 006 NW% TLO C,40
057 035 006 NW$ TRO C,RS.ALT
058 MOVEI B,(AR1)
059 127 020 JRST SSM4
060
061 SMCR2: LOCKI
062 065 067 JRST RSXST
063
064 181 046 SSM1: HRLI D,2
065 149 010 MOVE C,RCT0(D)
066 035 006 NW% TLNE C,4000 ;WAS IT ORIGINALLY A MACRO CHAR?
067 035 006 NW$ TLNE C,(RS.MAC)
068 035 006 MOVE C,D
069 127 020 JRST SSM4
SETSYNTAX AND OTHER READER SYNTAX FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 128
001
002 181 046 SSGCREL: TDZA D,D ;MUST HAVE USER INTERRUPTS OFF
003 181 046 SSGCPRO: MOVEI D,1
004 080 013 JSP T,SPATOM
005 209 011 JRST .+2
006 POPJ P,
007 SAVE A B
008 071 024 HRRZ R,(B)
009 071 024 CAIGE R,200
010 071 024 HRL R,VREADTABLE
011 071 024 HRRI R,IN0(R)
012 024 018 MOVE B,PROLIS
013 128 030 JUMPE D,SSGRL1
014 081 041 PUSHJ P,ASSOC
015 128 018 JUMPE A,SSPROQ
016 HLRZ A,(A)
017 MOVEM A,-1(P)
018 071 024 SSPROQ: MOVE B,R
019 073 012 PUSHJ P,CONS1
020 MOVE B,-1(P)
021 073 009 PUSHJ P,XCONS
022 024 018 MOVE B,PROLIS
023 073 010 PUSHJ P,CONS
024 024 018 MOVEM A,PROLIS
025 MOVE A,-1(P)
026 SSPROX: POP P,B
027 059 040 JRST POP1J
028
029 SSGRL2: MOVE A,-1(P)
030 081 042 SSGRL1: PUSHJ P,ASSQ
031 128 026 JUMPE A,SSPROX
032 HRRZ B,(B)
033 HRRZ T,(A)
034 071 024 CAME R,(T) ;COMPARES READTABLE AND NUMBER
035 128 029 JRST SSGRL2
036 024 018 MOVE B,PROLIS
037 092 032 PUSHJ P,.DELETE
038 024 018 MOVEM A,PROLIS
039 MOVEI A,0
040 128 026 JRST SSPROX
IOC AND IOG FUNCTIONS LISP.393[MAC,LSP] 01/17/78 Page 129
001
002 002 048 IFE QIO,[
003
004 SUBTTL IOC AND IOG FUNCTIONS
005
006 059 031 IOC: JUMPE A,CPOPJ ;FSUBR
007 129 010 HRROI R,IOC1
008 PUSHJ P,PRINTA
009 086 011 JRST TRUE
010 IOC1: CAIL A,"@ ;100
011 CAILE A,"↑ ;136
012 POPJ P,
013 020 016 SETZM IPCLOK
014 196 042 PUSHJ P,UINTPU
015 ANDCMI A,100
016 016 014 JSR CNTROL
017 196 017 IOC2: JRST UINTEX
018
019 054 054 IOG: PUSHJ P,IOGBND ;FSUBR
020 HRRZ B,(A)
021 HLRZ A,(A)
022 PUSH P,B
023 SKIPE A
024 129 006 PUSHJ P,IOC
025 POP P,B
026 164 066 PUSHJ P,IPROGN
027 049 033 JRST UNBIND
028
029 ] ;END OF IFE QIO
030
031 AUTOLOAD: HRL A,T
032 051 010 PUSHJ P,ACONS
033 MOVSS (A)
034 PUSH P,A ;FOR GC PROTECTION
035 002 048 IFE QIO,[
036 HRLI A,18. ;INTERRUPT NO. FOR AUTOLOAD FUN
037 MOVSS A
038 196 007 PUSHJ P,UINT
039 ] ;END OF IFE QIO
040 002 048 IFN QIO,[
041 181 046 PUSH FXP,D
042 181 046 MOVSI D,(A)
043 181 046 HRRI D,1000 ;AUTOLOAD USER INTERRUPT
044 196 007 PUSHJ P,UINT
045 181 046 POP FXP,D
046 ] ;END OF IFN QIO
047 059 040 JRST POP1J
SYSCALL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 130
001
002 002 026 IFN ITS,[
003
004 SUBTTL SYSCALL FUNCTION
005
006 181 046 SYSCALL: MOVEI D,QSYSCALL
007 CAML T,[-10.]
008 064 014 CAMLE T,XC-2
009 209 011 JRST WNALOSE
010 181 046 MOVEI D,2(P)
011 181 046 ADD D,T ;D POINTS TO ARG WITH .CALL NAME IN IT
012 021 034 MOVNM T,SYSCL8 ;#ARGS+2
013 JSP T,0PUSH+2(T) ;PUSH SLOTS FOR COPYING FIXNUM ARGS
014 181 046 SCSL0: MOVE A,-1(D)
015 065 007 JSP T,FXNV1 ;<CONTROL-BITS>,,<NUMBER-OF-OUTPUTS-DESIRED>
016 181 046 HLL D,TT
017 HRRZS TT
018 CAILE TT,20
019 130 074 JRST SCSTMA
020 021 034 HRLM TT,SYSCL8 ;#ANSWERS,,#ARGS+2
021 181 046 MOVE A,(D)
022 181 046 PUSH FXP,D
023 052 005 PUSHJ P,SIXMAK
024 131 052 MOVSI D,(SETZ)
025 181 046 EXCH D,(FXP) ;THE SETZ GETS PUT OUT HERE
026 071 024 MOVEI R,-1(FXP)
027 MOVEI F,(FXP)
028 PUSH FXP,TT ;THE SIXBIT FOR THE NAME OF THE .CALL
029 181 046 HLRZ T,D
030 181 046 TLZ D,-1
031 TLO T,5000 ;THE CONTROL BITS ARG
032 130 041 JRST SCSL1A
033
034 181 046 SCSL1: HRRZ T,(D)
035 SKOTT T,FX
036 130 041 JRST SCSL1A
037 MOVE TT,(T)
038 071 024 MOVEM TT,(R)
039 071 024 MOVEI T,(R)
040 071 024 SUBI R,1
041 SCSL1A: PUSH FXP,T
042 002 048 IFN QIO,[
043 MOVEI AR1,(T)
044 CAIN AR1,TRUTH
045 HRRZ AR1,V%TYI
046 071 024 MOVE T,R ;DOUBLE FOO - JONL!!
047 JSP TT,XFILEP
048 130 051 JRST SCSL6
049 MOVE TT,[@TTSAR]
050 ADDM TT,(FXP)
051 071 024 SCSL6: MOVE R,T
052 ] ;END OF IFN QIO
053 181 046 CAIGE D,(P) ;LOOP TO INSTALL REMAINING INPUT ARGS
SYSCALL FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 130.1
054 130 034 AOJA D,SCSL1
055 021 034 HLRZ D,SYSCL8
056 130 062 SOJL D,SCSL4
057 MOVEI T,1(FXP)
058 HRLI T,2000
059 SCSL3: PUSH FXP,T ;LOOP TO INSTALL ANSWER REQUESTS
060 ADDI T,1
061 130 059 SOJGE D,SCSL3
062 131 052 SCSL4: MOVSI T,(SETZ) ;FINAL SETZ SIGNALS END OF PARAMETERS
063 IORM T,(FXP) ;[THERE WILL ALWAYS BE AT LEAST ONE, I.E. THE CONTROL]
064 018 019 Q$ MOVEI TT,F.CHAN
065 .CALL (F)
066 130 077 JRST SCSFAI
067 SETZB A,B
068 021 034 HLRZ D,SYSCL8
069 130 085 SCSL5: JUMPE D,SCSXIT ;LOOP TO LISTIFY UP NUMERIC ANSWERS
070 POP FXP,TT
071 059 018 PUSHJ P,CONSFX
072 130 069 SOJA D,SCSL5
073
074 SCSTMA: MOVEI TT,15
075 130 089 JRST SCSXT1
076
077 071 024 SCSFAI: .SUSET [.RBCHN,,R]
078 130 094 .CALL SCSTAT
079 .VALUE
080 181 046 LDB TT,[220600,,D]
081 021 034 MOVE D,SYSCL8
082 181 046 HLRS D
083 181 046 SUB FXP,D ;TAKE OFF THE SLOTS FOR ANSWERS
084 074 007 JSP T,FXCONS ;LISP NUMBER FOR ERROR CODE
085 021 034 SCSXIT: MOVE D,SYSCL8 ;SYSCL8 HAS 2+#ARGS
086 181 046 ADDI D,-1(D) ;PUSHED WAS 3+2*#ARGS
087 181 046 HRLS D ; WHICH IS 2*SYSCL8-1
088 181 046 SUB FXP,D
089 021 034 SCSXT1: MOVE D,SYSCL8
090 181 046 HRLS D
091 181 046 SUB P,D ;STRAIGHTEN UP P
092 POPJ P,
093
094 131 052 SCSTAT: SETZ
095 SIXBIT \STATUS\ ;GET CHANNEL STATUS
096 071 024 ,,R ;CHANNEL #
097 181 046 402000,,D ;STATUS WORD
098 185 006 .SEE IOCERR
099 .SEE CHNI1
100
101 ] ;END OF IFN ITS
102
103
104
105 006 006 $INSRT STATUS ;HAIRY STATUS FUNCTIONS
CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 131
001
002 SUBTTL CURSORPOS FUNCTION
003
004 002 026 IFN USELESS*ITS,[
005 002 048 IFE QIO,[
006 057 027 CURSORPOS: JSP TT,LWNACK ;LSUBR (0 . 2) - HACK CURSOR
007 LA012,,QCURSORPOS ; FOR CHARACTER DISPLAYS
008 218 051 JSP R,PDLA2(T)
009 SKIPN TTYOFF ;↑W DISABLES, OF COURSE
010 030 042 SKIPN TTYDISP ;USELESS ON PRINTING TERMINALS
011 081 044 JRST FALSE
012 131 057 JUMPE T,CRSRP1 ;0 ARGS - GET POSITION
013 131 031 AOJE T,CRSRP3 ;1 ARG - SPECIAL HACKS (↑P CODES)
014 PUSH P,B ;2 ARGS - SET POSITION (↑P H, ↑P V)
015 071 024 MOVSI R,(ASCII \⊂V\) ;SET VERTICAL POSITION
016 131 019 PUSHJ P,CRSRP5
017 071 024 MOVSI R,(ASCII \⊂H\) ;SET HORIZONTAL POSITION
018 POP P,A
019 086 011 CRSRP5: JUMPE A,TRUE ;NIL MEANS NO CHANGE
020 065 007 JSP T,FXNV1
021 SKIPGE TT
022 131 052 SETZ TT,
023 CAILE TT,167 ;NOR ARG ABOVE 167
024 MOVEI TT,167
025 ADDI TT,10 ;ADD 10 FOR ↑P CROCK
026 071 024 DPB TT,[170700,,R]
027 071 024 CRSRP7: MOVEI D,R
028 PUSHJ P,SRNTYP ;SHOVE OUT ↑P COMMAND
029 086 011 JRST TRUE
030
031 080 013 CRSRP3: JSP T,SPATOM ;IF SYMBOL, USE FIRST CHAR
032 131 036 JRST CRSRP4
033 107 050 JSP T,CHNV1
034 131 037 JRST CRSRP6
035
036 065 007 CRSRP4: JSP T,FXNV1 ;ELSE BETTER BE FIXNUM
037 071 024 CRSRP6: MOVEI R,(TT)
038 TRC TT,100
039 TDNE TT,[-40]
040 209 011 JRST CRSRP2
041 MOVE TT,GCBT(TT)
042 131 049 TDNN TT,CRSRP9
043 209 011 JRST CRSRP2
044 071 024 LSH R,26 ;IF LEGAL, PUT A ↑P IN FRONT
045 071 024 TLO R,<↑P>←13 ; AND HAND IT OFF TO SRNTYP
046 071 024 MOVEI D,R
047 131 027 JRST CRSRP7
048
049 CRSRP9:
050 ZZZ==0
051 IRPC X,,[ABCDEFKLMNTUXZ[\]↑←]
052 004 063 ZZZ==ZZZ\<SETZ←-<"X&37>>
053 TERMIN
CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 131.1
054 004 063 ZZZ ;BITS SPECIFYING VALID ↑P CODES
055 004 063 EXPUNGE ZZZ ;NOTE: H, I, AND V NOT VALID HERE!
056
057 CRSRP1: .CALL RCPSBK ;GET CURRENT CURSOR POSITION
058 006 121 .LOSE 1400
059 181 046 MOVEI TT,(D) ;CONS THEM UP FOR LOSER
060 074 008 JSP T,FIX1A
061 MOVEI B,(A)
062 181 046 HLRZ TT,D
063 074 008 JSP T,FIX1A
064 073 010 JRST CONS
065 ] ;END OF IFE QIO
CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 132
001
002 ;;; IFN USELESS*ITS
003
004 002 048 IFN QIO,[
005 181 046 CURSORPOS: MOVEI D,QCURSORPOS ;LSUBR (0 . 3)
006 064 014 CAMGE T,XC-3 ;MORE THAN THREE ARGS LOSES
007 209 011 JRST WNALOSE
008 132 027 JUMPE T,CRSRP0 ;IF NO ARGS, IS FOR DEFAULT TTY
009 CRSRPS: SKIPN AR1,(P) ;ELSE LAST ARG MAY BE TTY FILE ARRAY
010 132 132 JRST CRSRN
011 MOVEI TT,(AR1)
012 005 042 LSH TT,-SEGLOG
013 036 033 SKIPGE ST(TT)
014 132 118 JRST CRSRMP
015 CAIN AR1,TRUTH ;LAST ARG = T
016 HRRZ AR1,V%TYO ; MEANS THE DEFAULT TTY
017 064 014 CRSR10: CAMN T,XC-3 ;FOR THREE ARGS MUST HAVE A FILE ARRAY
018 132 021 JRST CRSRP8
019 JSP TT,XFILEP ;FOR ONE OR TWO ARGS MAY OR MAY
020 132 027 JRST CRSRP0 ; NOT HAVE A FILE ARRAY
021 064 009 CRSRP8: SUB P,R70+1 ;IF WE HAVE ONE, IT MUST
022 PUSH FXP,T ; BE A BONA FIDE TTY OUTPUT FILE
023 PUSHJ P,TOFLOK
024 UNLOCKI
025 POP FXP,T
026 AOSA T
027 CRSRP0: HRRO AR1,V%TYO
028 218 051 JSP R,PDLA2(T)
029 018 018 MOVEI TT,F.MODE
030 181 046 MOVE D,@TTSAR(AR1)
031 SKIPGE AR1 ;IF FILE NOT EXPLICITLY GIVEN
032 SKIPN TTYOFF ; THEN ↑W NON-NIL => RETURN NIL
033 181 046 TLNN D,FBT<CP> ;RETURN NIL IF NOT DISPLAY
034 081 044 JRST FALSE
035 131 057 JUMPE T,CRSRP1 ;0 ARGS - GET POSITION
036 131 031 AOJE T,CRSRP3 ;1 ARG - SPECIAL HACKS (↑P CODES)
037 SKOTT A,FX ;2 ARGS
038 132 081 JRST CRSR11
039 181 046 MOVEI D,"V ;SET VERTICAL POSITION
040 131 019 PUSHJ P,CRSRP5
041 181 046 CRSR20: MOVEI D,"H ;SET HORIZONTAL POSITION
042 MOVEI A,(B)
043 086 011 CRSRP5: JUMPE A,TRUE ;NIL MEANS NO CHANGE
044 065 007 JSP T,FXNV1
045 SKIPGE TT
046 131 052 SETZ TT, ;NEGATIVE ARG NOT ALLOWED
047 CAILE TT,167 ;NOR ARG ABOVE 167
048 MOVEI TT,167
049 181 046 HRLI D,10(TT) ;ADD MAGIC 10 TO AMOUNT FOR ↑P
050 CRSRP7: PUSHJ P,CNPCOD
051 086 011 JRST TRUE
052
053 080 013 CRSRP3: JSP T,SPATOM ;IF SYMBOL, USE FIRST CHAR
CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 132.1
054 131 036 JRST CRSRP4
055 132 058 PUSHJ P,CRSR40
056 131 037 JRST CRSRP6
057
058 107 050 CRSR40: JSP T,CHNV1
059 CAIL TT,140
060 SUBI TT,40 ;CONVERT TO UPPER CASE
061 POPJ P,
062
063 065 007 CRSRP4: JSP T,FXNV1 ;ELSE BETTER BE FIXNUM
064 181 046 CRSRP6: MOVEI D,(TT)
065 TRC TT,100
066 TDNE TT,[-40]
067 209 011 JRST CRSRP2
068 MOVE TT,GCBT(TT)
069 131 049 TDNN TT,CRSRP9
070 209 011 JRST CRSRP2
071 131 027 JRST CRSRP7
072
073 CRSRP9:
074 ZZZ==0
075 IRPC X,,[ABCDEFKLMNTUXZ[\]↑←]
076 004 063 ZZZ==ZZZ\<SETZ←-<"X&37>>
077 TERMIN
078 004 063 ZZZ ;BITS SPECIFYING VALID ↑P CODES
079 004 063 EXPUNGE ZZZ ;NOTE: H, I, AND V NOT VALID HERE!
080
081 132 041 CRSR11: JUMPE A,CRSR20
082 080 013 JSP T,SPATOM
083 132 093 JRST CRSR12
084 132 058 PUSHJ P,CRSR40
085 065 007 JSP T,FXNV2
086 181 046 SKIPGE D
087 131 052 SETZ D,
088 CAIE TT,"H
089 CAIN TT,"V
090 132 096 JRST CRSR13
091 CAIN TT,"I
092 132 099 JRST CRSR14
093 131 006 CRSR12: WTA [BAD CURSOR CODE - CURSORPOS!]
094 132 081 JRST CRSR11
095
096 181 046 CRSR13: CAILE D,167
097 181 046 MOVEI D,167
098 181 046 ADDI D,10 ;H AND V RANDOMLY WANT 10 ADDED
099 181 046 CRSR14: MOVSI D,400000(D) .SEE CNPCD1 ;KEEP LH FROM BEING ZERO
100 181 046 HRRI D,(TT)
101 131 027 JRST CRSRP7
102
103 CRSRP1: PUSHJ P,FORCE1
104 018 018 MOVEI TT,F.MODE
105 MOVE F,@TTSAR(AR1)
106 018 019 MOVEI TT,F.CHAN
CURSORPOS FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 132.2
107 .CALL RCPOS ;GET CURRENT CURSOR POSITION
108 006 121 .LOSE 1400
109 TLNE F,FBT<EC> ;GET ECHO MODE POSITION
110 071 024 MOVE D,R ; IF FILE IS FOR ECHO AREA
111 181 046 MOVEI TT,(D) ;CONS THEM UP FOR LOSER
112 074 008 JSP T,FIX1A
113 MOVEI B,(A)
114 181 046 HLRZ TT,D
115 074 008 JSP T,FIX1A
116 073 010 JRST CONS
117
118 CRSRMP: PUSH FXP,T
119 CRSRM1: HLRZ A,@(P)
120 MOVE T,(FXP)
121 MOVEI TT,(T)
122 ADDI TT,(P)
123 PUSH P,1(TT)
124 TRNE T,1
125 PUSH P,2(TT)
126 PUSH P,A
127 132 009 PUSHJ P,CRSRPS
128 HRRZ A,@(P)
129 MOVEM A,(P)
130 132 119 JUMPN A,CRSRM1
131 POP FXP,T
132 CRSRN: MOVEI A,TRUTH
133 175 015 JRST PROGN1
134 ] ;END OF IFN QIO
135 ] ;END OF IFN USELESS*ITS
RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 133
001
002 002 046 IFN FUNAFL,[
003
004 SUBTTL RANDOM ROUTINES TO HANDLE A PSEUDO ALIST
005
006 181 046 %%FUNCTION: MOVEI D,Q%%FUNCTION
007 JUMPE A,WNAFOSE
008 035 006 HRRZ C,(A)
009 133 017 JUMPN C,.FUNC1
010 HLRZ B,(A) ;HALF-ASSED FUNARG BINDING
011 HRROI TT,(SP) ;ONE LH AS GOOD AS ANOTHER
012 074 008 JSP T,FIX1A
013 073 009 PUSHJ P,XCONS
014 .FUNC4: MOVEI B,QFUNARG
015 073 009 JRST XCONS
016
017 .FUNC1: HLRZ AR2A,(A)
018 035 006 HLRZ AR1,(C)
019 035 006 HRRZ C,(C)
020 035 006 JUMPN C,WNAFOSE
021 133 033 .FUNC2: JUMPE AR1,.FUNC3
022 HLRZ A,(AR1)
023 080 013 JSP T,SPATOM
024 JSP T,PNGE1
025 HLRZ B,(A)
026 HLRZ B,@(B)
027 073 010 PUSHJ P,CONS
028 035 006 MOVEI B,(C)
029 073 010 PUSHJ P,CONS
030 HRRZ AR1,(AR1)
031 133 021 JRST .FUNC2
032
033 035 006 .FUNC3: MOVEI A,(C)
034 MOVEI B,TRUTH
035 089 056 PUSHJ P,NRECONC
036 MOVEI B,(AR2A)
037 073 010 PUSHJ P,CONS
038 133 014 JRST .FUNC4
039
040 AEVAL: SKIPE A,(P) ;PURPOSELY CRIPPLING POWER OF ALIST
041 065 007 JSP T,FXNV1 ; ROUTINE: FOOEY! - GLS
042 134 052 PUSHJ P,ALIST ;EVAL WITH AN ALIST
043 064 009 SUB P,R70+1
044 POP P,A
045 SKIPE T ;ALIST RETURNING NON-ZERO IN T =>
046 137 024 PUSH P,CAUNBIND ; TWO BIND BLOCKS WERE PUSHED
047 137 024 PUSH P,CAUNBIND
048 POP FXP,T ;SKIP 1 RETURN
049 209 011 JRST 1(T)
RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 134
001
002 ;;; IFN FUNAFL
003
004 ;;; ALIST CREATES AN ENVIRONMENT AS SPECIFIED BY A GIVEN A-LIST.
005 ;;; AN A-LIST MAY BE:
006 ;;; [1] NIL, MEANING THE TOP-LEVEL ENVIRONMENT.
007 ;;; [2] T, MEANING THE CURRENT ENVIRONMENT (SEE [4]).
008 ;;; [3] A FIXNUM REPRESENTING A SPECPDL POINTER, AS
009 ;;; RETURNED BY THE EVALFRAME FUNCTION AS THE FOURTH
010 ;;; ITEM. THIS INDICATES THE ENVIRONMENT AS OF
011 ;;; THE SPECIFIED FRAME.
012 ;;; [4] ((<SYMBOL> . <VALUE>) . <A-LIST>)
013 ;;; THAT IS, ONTO ONE OF THE OTHER THREE KINDS OF A-LIST
014 ;;; ONE MAY CONS ADDITIONAL VARIABLE-VALUE PAIRS IN
015 ;;; THE USUAL MANNER. THIS IS A "TRUE A-LIST".
016 ;;; THIS ENVIRONMENT IS CREATED BY REBINDING ALL VARIABLES
017 ;;; WHICH HAVE BEEN BOUND SINCE THEN BACK TO THEIR OLD VALUES,
018 ;;; OR TO THE VALUES SPECIFIED BY THE TRUE A-LIST. IF A GIVEN
019 ;;; VARIABLE WAS BOUND SEVERAL TIMES, ONLY ONE REBINDING IS DONE
020 ;;; TO RECREATE THE OLD ENVIRONMENT. THIS IS DONE BY USING THE
021 ;;; LEFT HALF OF A VALUE CELL TO INDICATE WHETHER OR NOT IT
022 ;;; HAS ALREADY BEEN REBOUND. THIS HAS THE CONSEQUENCE THAT
023 ;;; NOQUIT MUST BE TURNED ON DURING THIS OPERATION.
024 ;;; EITHER ONE OR TWO SPECPDL BLOCKS ARE PUSHED, THE SECOND ONE
025 ;;; BEING NECESSARY IF ANY TRUE A-LIST IS GIVEN. THERE ARE FOUR
026 ;;; STEPS TO THE PROCESS:
027 ;;; [1] CHECK ARGUMENT THOROUGHLY FOR ERRORS. IF A TRUE
028 ;;; A-LIST IS GIVEN, ALL SYMBOLS ON THE A-LIST ARE GIVEN
029 ;;; VALUE CELLS IF THEY DON'T HAVE ANY ALREADY.
030 ;;; [2] TURN ON NOQUIT. IF A TRUE A-LIST IS GIVEN, BIND ALL
031 ;;; THE SYMBOLS AS SPECIFIED, MARKING THE VALUE CELLS
032 ;;; AS THEY ARE BOUND, AND NEVER BINDING A SYMBOL TWICE.
033 ;;; WHEN DONE, PUSH THE TRUE A-LIST ONTO THE SPECPDL
034 ;;; SO THAT AUNBIND CAN RESTORE THINGS CORRECTLY.
035 ;;; [3] SCAN THE SPECPDL FROM THE POINT SPECIFIED BY THE
036 ;;; SPECPDL POINTER (FROM THE BOTTOM IF NIL), AND BIND
037 ;;; ALL VALUES CELLS SEEN BACK TO THEIR OLD VALUES,
038 ;;; MARKING THEM AS THEY ARE BOUND, NEVER BINDING ONE
039 ;;; TWICE. WHEN DONE, PUSH A POINTER ON THE SPECPDL
040 ;;; SO THAT AUNBIND CAN RESTORE THINGS CORRECTLY.
041 ;;; [4] SCAN BACK OVER ALL THE ITEMS PUSHED IN STEPS 2
042 ;;; AND 3, RESTORING THE LAFT HALVES OF ALL THE VALUE
043 ;;; CELLS. TURN OFF NOQUIT AND CHECK FOR INTERRUPTS.
044 ;;; ON RETURN, A-LIST LEAVES T NON-ZERO IFF TWO BIND BLOCKS
045 ;;; WERE PUSHED. IT IS UP TO THE CALLER TO MAKE SURE THAT THE
046 ;;; BLOCK(S) ARE UNBOUND CORRECTLY WITH AUNBIND.
047 ;;; NOTE THAT ERRPOP CAN RECOGNIZE THESE SPECIAL BIND BLOCKS AND
048 ;;; CALL AUNBIND TO UNBIND THEM. THIS IS BECAUSE THE LAST WORD
049 ;;; PUSHED HAS ZERO IN THE LEFT HALF.
050
051
052 035 006 ALIST: SKIPN C,-1(P) ;MAKE COPY OF ENVIRONMENT GIVEN A-LIST
053 135 010 ALST1: JUMPE C,ALST3 ;STEP 1 - ERROR CHECKING
RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 134.1
054 035 006 CAIN C,TRUTH
055 135 010 JRST ALST3 ;T AND NIL ARE VALID A-LISTS
056 035 006 SKOTT C,LS
057 135 004 JRST ALST2 ;NOPE - GO CHECK IT OUT
058 035 006 HLRZ AR1,(C) ;YUP - CHECK ITS CAR
059 035 006 HRRZ C,(C)
060 SKOTT AR1,LS
061 209 011 JRST ALST0
062 HLRZ A,(AR1)
063 SKOTT A,SY
064 209 011 JRST ALST0
065 CAIN A,TRUTH
066 209 011 JRST ALST0
067 HLRZ AR1,(A)
068 HRRZ B,(AR1)
069 MOVEI AR1,QUNBOUND
070 CAIN B,SUNBOUND
071 057 007 JSP T,.SET1
072 134 053 JRST ALST1
RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 135
001
002 ;;; IFN FUNAFL
003
004 ALST2: TLNN TT,FX ; - DARN WELL BETTER BE A FIXNUM
005 209 011 JRST ALST0
006 035 006 HRRZ TT,(C) ;MUST BE A VALID SPECPDL POINTER
007 027 068 CAML TT,ZSC2
008 CAILE TT,(SP)
009 209 011 JRST ALST0
010 015 019 ALST3: HLLOS NOQUIT ;TURN ON NOQUIT - MUSTN'T INTERRUPT
011 029 009 HLLOS MUNGP ;ABOUT TO MUNG VALUE CELLS!
012 014 066 MOVEM SP,SPSV ;STEP 2 - PUSH BLOCK FOR TRUE A-LIST
013 131 052 SETZ T, ;T WILL BECOME NON-ZERO IF TRUE
014 035 006 SKIPN C,-1(P) ; A-LIST IS PRESENT AT ALL
015 135 033 ALST3A: JUMPE C,ALST4 ;NIL FOUND
016 035 006 CAIN C,TRUTH
017 136 004 JRST ALST7 ;T FOUND
018 035 006 SKOTT C,LS
019 135 034 JRST ALST4A ;FIXNUM FOUND
020 035 006 HLRZ B,(C)
021 035 006 HRRZ C,(C)
022 HLRZ A,(B) ;A HAS ATOMIC SYMBOL
023 HRRZ AR1,(B) ;AR1 HAS ASSOCIATED VALUE
024 HLRZ B,(A)
025 HRRZ A,(B)
026 SKIPGE AR2A,(A) ;SKIP UNLESS VALUE CELL MARKED
027 135 015 JRST ALST3A ;VALUE CELL ALREADY REBOUND
028 HRLI AR2A,(A) ;PUSH <VALUE CELL,,CURRENT VALUE>
029 PUSH SP,AR2A ; ONTO SPECPDL; THEN INSTALL
030 HRROM AR1,(A) ; VALUE FROM ENVIRONMENT, MARKING CELL
031 135 015 AOJA T,ALST3A ;T NON-ZERO => WE PUSHED SOMETHING
032
033 027 064 ALST4: MOVEI C,SC2 ;NIL => TOP LEVEL ENVIRONMENT
034 035 006 ALST4A: HRRZ C,(C) ;FIXNUM => SPECIFIED ENVIRONMENT
035 014 066 HRRZ B,SPSV
036 135 040 JUMPE T,ALST4C ;IF ANYTHING PUSHED, START NEW BLOCK
037 PUSH SP,-1(P) ;LEFT HALF BETTER BE ZERO!
038 014 066 PUSH SP,SPSV ;FINISH OFF BLOCK FOR TRUE A-LIST
039 014 066 MOVEM SP,SPSV ;START NEW BLOCK FOR FUNARG POINTER
040 035 006 ALST4C: MOVEI TT,(C) ;STEP 3 - SCAN SPECPDL FROM ENVIRONMENT
041 ALST5: CAIN TT,(B) ; BACK UP TO POINT WHEN ALIST CALLED
042 136 007 JRST ALST6
043 HRRZ AR1,(TT) ;GET VALUE FROM SPECPDL
044 027 068 CAMGE AR1,ZSC2 ;IGNORE SPECPDL POINTERS
045 135 048 JRST ALST5A
046 CAIGE AR1,(SP)
047 135 041 AOJA TT,ALST5
048 ALST5A: HLRZ A,(TT) ;GET VALUE CELL FROM SLOT
049 135 051 JUMPE A,AL5AB ;IGNORE FROBS ALIST PUSHES!
050 SKIPGE AR2A,(A) ;IGNORE MARKED VALUE CELLS
051 135 041 AL5AB: AOJA TT,ALST5
052 HRLI AR2A,(A) ;ELSE PUSH AS BEFORE
053 PUSH SP,AR2A
RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 135.1
054 HRROM AR1,(A)
055 135 041 AOJA TT,ALST5
RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 136
001
002 ;;; IFN FUNAFL
003
004 035 006 ALST7: HRRZ C,-1(P) ;T => CURRENT ENVIRONMENT
005 131 052 SETZ T, ;ONLY ONE BLOCK PUSHED
006 014 066 HRRZ B,SPSV
007 035 006 ALST6: PUSH SP,C ;STEP 4 - RESTORE VALUE CELLS
008 ALST6A: CAIN B,(SP)
009 136 016 JRST ALST7A
010 HLRZ A,(B)
011 136 014 JUMPE A,ALST6B
012 027 068 CAMGE A,ZSC2
013 HRRZS (A)
014 136 008 ALST6B: AOJA B,ALST6A
015
016 014 066 ALST7A: PUSH SP,SPSV ;CLOSE BIND BLOCK
017 029 009 HLLZS MUNGP ;VALUE CELLS UNMUNGED
018 209 011 JRST CZECHI ;ALL DONE - CHECK INTERRUPTS
019
020 ;;; AUNBIND UNDOES A FUNARG BIND BLOCK PUSHED BY ALIST.
021 ;;; IT DOES SO BY SCANNING UP THE SPECPDL FROM THE POINT OF
022 ;;; THE FUNARG ENVIRONMENT, OR BY SCANNING DOWN THE TRUE A-LIST,
023 ;;; CLOBBERING CURRENT VALUES FROM VALUE CELLS INTO SPECPDL
024 ;;; SLOTS OR A-LIST SLOTS AS APPROPRIATE, SO THAT ANY SETQ'S
025 ;;; DONE IN THE CREATED COPY OF THE ENVIRONMENT WILL BE
026 ;;; REFLECTED IN THE ORIGINAL ENVIRONMENT.
027
028 AUNBIND: POP SP,T
029 020 053 AUNBN0: MOVEM TT,UNBND3
030 020 058 MOVEM D,AUNBD
031 021 014 MOVEM R,AUNBR
032 021 022 MOVEM F,AUNBF
033 MOVEI F,1(T)
034 071 024 HRRZ R,(SP)
035 027 068 CAMGE R,ZSC2
036 136 053 JRST AUNBN4
037 AUNBN1: CAIN F,(SP) ;CLOBBER SETQ'S BACK INTO SPECPDL
038 136 047 JRST AUNBN3
039 181 046 HLRZ D,(F)
040 071 024 AUNBN2: HLRZ TT,(R)
041 181 046 CAIE TT,(D)
042 136 040 AOJA R,AUNBN2
043 HRRZ TT,(TT)
044 071 024 HRRM TT,(R)
045 136 037 AOJA F,AUNBN1
046
047 021 022 AUNBN3: MOVE F,AUNBF
048 021 014 MOVE R,AUNBR
049 020 058 MOVE D,AUNBD
050 064 009 SUB SP,R70+1
051 049 035 JRST UNBND0
052
053 AUNBN4: ;CLOBBER SETQ'S BACK INTO TRUE A-LIST
RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 136.1
054 AUNBN5: CAIN F,(SP)
055 136 047 JRST AUNBN3
056 181 046 HLRZ D,(F)
057 136 060 JRST AUNBN7
058
059 071 024 AUNBN6: HRRZ R,(R)
060 071 024 AUNBN7: HLRZ TT,(R)
061 HLRZ TT,(TT)
062 HLRZ TT,(TT)
063 HRRZ TT,(TT)
064 181 046 CAIE TT,(D)
065 136 059 JRST AUNBN6
066 071 024 HLRZ TT,(R)
067 181 046 HRRZ D,(D)
068 181 046 HRRM D,(TT)
069 136 054 AOJA F,AUNBN5
070
RANDOM ROUTINES TO HANDLE A PSEUDO ALIST LISP.393[MAC,LSP] 01/17/78 Page 137
001
002 ;;; IFN FUNAFL
003
004 071 024 IAP4A: MOVEM TT,R ;AT THIS POINT, WE MAKE UP AN
005 HRROI TT,(SP)
006 074 008 JSP T,FIX1A
007 PUSH P,A
008 071 024 MOVE TT,R
009 071 024 MOVNI R,2
010 MOVNI T,1
011 164 014 JRST IAP5
012
013 APFNG: HRRZ A,(B) ;APPLY FUNARG
014 HLRZ B,(B)
015 035 006 HRRM B,(C)
016 PUSH P,A
017 021 019 MOVEM T,APFNG1
018 134 052 PUSHJ P,ALIST
019 PUSH P,.
020 HRROI TT,-2(P)
021 021 019 MOVE D,APFNG1
022 POP TT,2(TT)
023 181 046 AOJLE D,.-1
024 136 028 CAUNBIND: MOVEI D,AUNBIND
025 181 046 MOVEM D,2(TT)
026 SKIPN T
027 059 031 MOVEI D,CPOPJ
028 181 046 MOVEM D,1(TT)
029 021 019 MOVE T,APFNG1
030 161 015 JRST IAPPLY
031
032
033 APLBL: HLRZ A,(B)
034 HRRZ B,(B)
035 HLRZ AR1,(B)
036 035 006 MOVEM AR1,(C)
037 014 066 MOVEM SP,SPSV ;APPLY LABEL EXPRESSION
038 050 010 PUSHJ P,BIND
039 014 010 PUSHJ P,ABIND3
040 137 045 MOVEI A,APLBL1
041 035 006 EXCH A,-1(C)
042 035 006 HLLM A,-1(C)
043 PUSH FXP,A
044 161 015 JRST IAPPLY
045 049 033 APLBL1: PUSHJ P,UNBIND
046 POPJ FXP,
047
048 ] ;END OF IFN FUNAFL
LISTIFY, PNPUT, AND PNGET LISP.393[MAC,LSP] 01/17/78 Page 138
001
002 SUBTTL LISTIFY, PNPUT, AND PNGET
003
004 071 024 LISTIFY: SKIPN R,ARGLOC
005 209 011 JRST LFYER
006 065 007 JSP T,FXNV1 ;LISTIFY UP N ARGS FOR AN LSUBR
007 181 046 MOVM D,TT
008 181 046 CAMLE D,@ARGNUM
009 209 011 JRST LFY0
010 138 013 JUMPGE TT,LFY3
011 071 024 ADD R,@ARGNUM
012 071 024 SUBI R,(D)
013 181 046 LFY3: HRLOI TT,(D) ;SEE HAKMEM (A.I. MEMO 239) ITEM 156
014 071 024 EQVI TT,(R) ;TT GETS <-N-1>,,<CONTENTS OF ARGLOC>
015 081 044 AOBJP TT,FALSE ;ZERO ARGS
016 064 009 PUSH P,R70
017 071 024 MOVEI R,(P) ;T HOLDS LAST POINTER
018 LFY1: MOVE A,(TT) ;GET ARG
019 094 012 JSP T,PDLNMK
020 073 008 PUSHJ P,NCONS
021 071 024 HRRM A,(R) ;CLOBBER ONTO END OF LIST
022 071 024 MOVEI R,(A) ;ADVANCE LAST POINTER
023 138 018 AOBJN TT,LFY1
024 059 035 JRST POPAJ
025
026
027 072 013 PNPUT: JUMPE B,SYCONS
028 PUSH P,A
029 021 012 SETZM LPNF
030 104 007 JRST INTRN1
031
032 082 048 $PNGET: PUSHJ P,PNGET
033 035 006 MOVE C,A
034 065 007 JSP T,FXNV2
035 MOVEI B,0
036 CAIN TT+1,7
037 POPJ P,
038 CAIE TT+1,6
039 082 048 LERR [SIXBIT \FEATURE NOT YET IMPLEMENTED - PNGET!\]
040 181 046 TDZA D,D
041 059 018 $PNG.R: PUSHJ P,CONSFX
042 131 052 SETZ TT,
043 071 024 MOVE R,[440600,,TT]
044 181 046 $PNG3: TLNN D,760000
045 138 054 JRST $PNG.D
046 071 024 $PNG3A: TLNN R,740000
047 138 041 JRST $PNG.R
048 181 046 $PNG4: ILDB T,D ;GET NEXT ASCII BYTE
049 138 060 JUMPE T,$PNGX
050 CAIGE T,140 ;CHECK FOR LOWER-CASE
051 ADDI T,40 ;CONVERT, AND STORE
052 071 024 IDPB T,R
053 138 044 JRST $PNG3
LISTIFY, PNPUT, AND PNGET LISP.393[MAC,LSP] 01/17/78 Page 138.1
054 138 060 $PNG.D: JUMPE C,$PNGX
055 035 006 HLRZ F,(C) ;CONSTRUCT WORD OF ASCII, AND BPTR THERETO
056 MOVE F,(F)
057 035 006 HRRZ C,(C)
058 181 046 MOVE D,[440700,,F]
059 138 046 JRST $PNG3A
060 $PNGX: JUMPE TT,.+2
061 059 018 PUSHJ P,CONSFX
062 089 055 JRST NREVERSE
063
EXAMINE, DEPOSIT, MAKNUM, MUNKAM LISP.393[MAC,LSP] 01/17/78 Page 139
001
002 SUBTTL EXAMINE, DEPOSIT, MAKNUM, MUNKAM
003
004
005 DEPOSIT: EXCH A,B
006 065 007 JSP T,FXNV2
007 062 010 JSP T,FLTSKP
008 JFCL
009 MOVEM TT,(TT+1)
010 086 011 JRST TRUE
011
012 064 007 EXAMINE: PUSH P,CFIX1
013 065 007 JSP T,FXNV1
014 MOVE TT,(TT)
015 POPJ P,
016
017 MAKNUM: MOVEI TT,(A)
018 074 006 JRST FIX1
019
020 065 007 MUNKAM: JSP T,FXNV1
021 MOVEI A,(TT)
022 POPJ P,
SLEEP, LISTEN, ALARMCLOCK LISP.393[MAC,LSP] 01/17/78 Page 140
001
002 SUBTTL SLEEP, LISTEN, ALARMCLOCK
003
004 ;;; (SLEEP <N>) SLEEPS FOR <N> SECONDS. <N> MAY BE A FIXNUM OR FLONUM.
005
006 062 010 $SLEEP: JSP T,FLTSKP ;SUBR 1
007 IT% CAIA
008 140 103 IT$ JSP T,M30.
009 IT$ FMPR TT,[30.0]
010 064 022 JSP T,IFIX
011 IT$ .SLEEP TT, ;SLEEP FOR <TT> 30TH'S OF A SECOND
012 10$ SLEEP TT, ;SLEEP FOR <TT> SECONDS
013 005 006 IFN D20,[
014 WARN [INTERRUPTING OUT OF SLEEP REQUIRES THOUGHT]
015 IMULI TT,1000.
016 SPECPRO INTSLP ;MUST PROTECT THIS IN CASE OF INTERRUPTS
017 MOVE 1,TT ;(A) WE WANT TO ALLOW INTERRUPTS TO GO THROUGH
018 DISMS ;(B) WE MUST BEWARE OF CRUD IN AC 1
019 168 004 WARN [WHAT DO WE DO ABOUT INTERRUPT OUT OF DISMS ON D20?]
020 XCTPRO
021 131 052 SETZ 1,
022 NOPRO
023 ] ;END OF IFN D20
024 086 011 JRST TRUE
025
026 002 029 IFN SAIL,[
027 ALARMCLOCK: EXCH A,B
028 140 064 JUMPE A,SALCK0 ;TECHNICALLY NOT NECESSARY, BECAUSE (CAR NIL) = (CDR NIL) = NIL, BUT...
029 SKIPN (A)
030 140 064 JRST SALCK0
031 030 079 MOVEI TT,SAILJOB
032 MOVEM TT,71
033 030 073 MOVEM B,ACLKTYP
034 CAIE B,Q$RUNTIME
035 140 051 JRST ALCK1
036 062 010 JSP T,FLTSKP ;RUN TIME IN MICROSECONDS,
037 CAIA ; ACCURATE TO 4. USEC JIFFIES
038 064 022 JSP T,IFIX
039 IDIVI TT,1000. ;RUN TIME IN MILLISECONDS
040 181 046 MOVE D,TT
041 131 052 SETZ TT,
042 RUNTIME TT,
043 181 046 ADD TT,D
044 030 078 MOVEM TT,SAIALK
045 180 004 MOVEI TT,SAILINT ;THIS IS WHERE INTERRUPT ROUTINE IS
046 030 079 HRRZM TT,SAILJOB+2
047 030 076 IMSKST SAINTER ;MASK THEM ON
048 CLKINT 36 ;SET INTERVAL
049 086 011 ALCK4: JRST TRUE
050
051 ALCK1: CAIE B,QTIME
052 209 011 JRST ALCK0
053 062 010 JSP T,FLTSKP ;REAL TIME IN SECONDS,
SLEEP, LISTEN, ALARMCLOCK LISP.393[MAC,LSP] 01/17/78 Page 140.1
054 140 068 JSP T,M6. ; ACCURATE TO SIXTHS
055 FMPRI TT,(6.0)
056 064 022 JSP T,IFIX
057 030 078 MOVEM TT,SAIALK ;NUMBER OF CLKINTS TO GO
058 180 037 MOVEI TT,S2ILIN2
059 030 079 HRRZM TT,SAILJOB+2
060 030 076 IMSKST SAINTER ;MASK ON
061 CLKINT 12 ;ENABLE & GO
062 140 049 JRST ALCK4
063
064 030 076 SALCK0: IMSKCL SAINTER ;UNMASK
065 CLKINT 0 ;DISABLE
066 081 044 JRST FALSE
067
068 M6.: IMULI TT,6. ;NOTE: DOUBLE SKIP RETURN
069 209 011 JRST 2(T)
070 ] ;END OF IFN SAIL
071
072
073 002 026 IFN ITS,[
074 ALARMCLOCK: EXCH A,B
075 SETO TT,
076 CAIE B,Q$RUNTIME
077 140 051 JRST ALCK1
078 140 083 JUMPE A,ALCK3 ;NIL => TURN OFF CLOCK
079 062 010 JSP T,FLTSKP ;RUN TIME IN MICROSECONDS,
080 209 011 JRST .+2 ; ACCURATE TO 4. USEC JIFFIES
081 064 022 JSP T,IFIX
082 ASH TT,-2
083 ALCK3: .SUSET [.SRTMR,,TT]
084 081 044 ALCK4: JUMPL TT,FALSE
085 086 011 JRST TRUE
086
087 ALCK1: CAIE B,QTIME
088 209 011 JRST ALCK0
089 140 095 JUMPE A,ALCK5 ;NIL => TURN OFF CLOCK
090 062 010 JSP T,FLTSKP ;REAL TIME IN SECONDS,
091 140 103 JSP T,M30. ; ACCURATE TO 30TH'S
092 FMPRI TT,(30.0)
093 064 022 JSP T,IFIX
094 ASH TT,1
095 071 024 ALCK5: MOVSI R,400000
096 140 100 JUMPL TT,ALCK2
097 140 099 JUMPN TT,ALCK7
098 MOVEI TT,1 ;IF 0 SPECIFIED, USE 1/30 SECOND
099 071 024 ALCK7: MOVE R,[600000,,TT]
100 071 024 ALCK2: .REALT R,
101 140 049 JRST ALCK4
102
103 M30.: IMULI TT,30. ;NOTE: DOUBLE SKIP RETURN
104 209 011 JRST 2(T)
105
106 ] ;END OF IFN ITS
SLEEP, LISTEN, ALARMCLOCK LISP.393[MAC,LSP] 01/17/78 Page 140.2
107
108 002 048 IFE QIO,[
109 064 007 LISTEN: PUSH P,CFIX1
110 071 024 IT$ .LISTEN R,
111 005 005 IFN D10,[
112 030 043 SKIPE LINMODE
113 SA% SKIPA TT,[SKPINL]
114 SA$ SKIPA TT,[INWAIT]
115 SA% MOVSI TT,(SKPINC)
116 SA$ MOVSI TT,(INSKIP)
117 209 025 XCT TT
118 071 024 TDZA R,R
119 071 024 MOVEI R,1
120 ] ;END OF IFN D10
121 032 006 SKIPE PBFTY
122 071 024 AOS R
123 HRRZ A,RDTYBF
124 JSP T,LNG1A
125 071 024 ADD TT,R
126 POPJ P,
127 ] ;END OF IFE QIO
128
129 ; ENDCODE [SLEEP/LISTEN/ALARM]
REMOB, ARG, SETARG LISP.393[MAC,LSP] 01/17/78 Page 141
001
002 SUBTTL REMOB, ARG, SETARG
003
004 080 013 REMOB: JSP T,SPATOM ;SUBR 1 - REMOVE ATOMIC SYMBOL FROM OBARRAY
005 JSP T,PNGE ;ERROR IF ARG NOT A SYMBOL
006 LOCKI
007 104 004 PUSHJ P,INTERN
008 141 011 JRST REMOB7
009
010 REMOB2: LOCKI
011 REMOB7: EXCH A,B ;OBTBL BUCKET # SHOULD BE IN TT
012 071 024 MOVE R,TT
013 181 046 HRRZ D,VOBARRAY
014 181 046 HRRI TT,@TTSAR(D)
015 014 026 PUSHJ P,ARYGT4
016 HLRZ T,(A)
017 CAIN T,(B)
018 141 032 JRST REMOB1
019 181 046 REMOB3: MOVE D,A
020 HRRZ A,(A)
021 HLRZ T,(A)
022 CAIE T,(B)
023 141 019 JRST REMOB3
024 HRRZ T,(A)
025 181 046 HRRM T,(D)
026 REMOB4: HLRZ TT,(B) ;LEAVE ATOM HEADER IN T
027 HRRZ TT,1(TT) ;LEAVE PNAME LINK IN TT
028 JSP T,GCP8L ;CHECK TO SEE THAT SCOS ARE REMOVED FROM SCO TABLE.
029 SETZB A,B
030 UNLKPOPJ
031
032 REMOB1: HRRZ A,(A)
033 056 014 JSP T,.STOR0
034 141 026 JRST REMOB4
035
036
037 141 042 ARG: JUMPE A,ARG3 ;SUBR 1 - FETCH LSUBR ARGUMENT
038 141 053 ARGXX: JSP R,ARGCOM
039 181 046 HRRZ A,(D)
040 094 011 JRST PDLNKJ
041
042 ARG3: SKIPN ARGLOC ;(ARG NIL) RETURNS NUMBER OF LSUBR ARGUMENTS
043 209 011 JRST ARGCM1
044 HRRZ A,ARGNUM
045 094 011 JRST PDLNKJ
046
047 141 053 SETARG: JSP R,ARGCOM ;SUBR 2 - SET LSUBR ARGUMENT
048 MOVE A,B
049 094 012 JSP T,PDLNMK
050 181 046 HRRM A,(D)
051 POPJ P,
052
053 181 046 ARGCOM: SKIPN D,ARGLOC
REMOB, ARG, SETARG LISP.393[MAC,LSP] 01/17/78 Page 141.1
054 209 011 JRST ARGCM0
055 065 007 JSP T,FXNV1
056 JUMPLE TT,ARGCM8
057 CAMLE TT,@ARGNUM
058 209 011 JRST ARGCM8
059 181 046 ADD D,TT
060 209 011 JRST (R)
P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 142
001
002
003 SUBTTL P.$X AND FRIENDS
004
005 032 033 10% DEPURE: JSR POFF ;DEPURIFY A PAGE
006 032 033 10% REPURE: JSR POFF ;REPURIFY A PAGE
007 032 033 SBSYM: JSR POFF ;FIND SUBR NAME (ADR IN RH OF .)
008 032 033 VCLSYM: JSR POFF ;FIND ATOM FOR VC (ADR IN LH OF .)
009 032 033 VCSYM: JSR POFF ;FIND ATOM FOR VALUE CELL
010 032 033 TLSYM: JSR POFF ;PRINT ST ENTRY OF LEFT HALF OF A CELL
011 032 033 TSYM: JSR POFF ;ST ENTRY OF RIGHT HALF
012 032 033 PLSYM: JSR POFF ;PRINT LEFT HALF OF A CELL
013 032 033 PSYM: JSR POFF ;PRINT RIGHT HALF OF A CELL
014 032 033 POF: JSR POFF ;PRINT ARG (POINTER AT LOC 40)
015 032 033 TOF: JSR POFF ;ST ENTRY OF ARG (POINTER IN 40)
016 032 033 10% P%OFF: JSR POFF ;FOR % TYPEOUT MODE IN DDT
017 032 033 10% PPTBL: JSR POFF ;PRINT OUT PURTBL
018 032 033 10% PPPAG: JSR POFF ;PRINT OUT ACTUAL PAGE STATUSES
019 ;POFF: 0
020 032 032 PSYM1: SETOM PSYMF
021 032 037 MOVEM T,PSMTS ;P.$X, DONE IN DDT,
022 032 038 MOVEM R,PSMRS ; WILL PRINT CONTENTS
023 145 015 MOVEI T,LPSMTB ; OF CURRENT OPEN CELL
024 145 006 MOVE R,@PSMTB-1(T) ; IN LISP FORMAT.
025 032 035 MOVEM R,PSMS-1(T)
026 SOJN T,.-2
027 032 033 HRRZ T,POFF
028 142 006 10% CAIG T,REPURE+1
029 144 049 10% JRST PUFY
030 143 038 PUSH P,CPSYMX
031 057 038 JSP T,ERSTP
032 020 028 MOVEM P,ERRTN
033 MOVEI T,40
034 032 040 MOVEM T,PS.S
035 032 033 HRRZ R,POFF
036 002 026 IFN ITS,[
037 012 004 MOVEI T,THIRTY+7
038 142 016 CAIN R,P%OFF+1
039 032 040 MOVEM T,PS.S
040 142 014 CAIG R,POF
041 145 017 .BREAK 12,PSMST
042 ] ;END OF IFN ITS
043 005 005 IFN D10,[
044 HRRZ T,.JBDDT"
045 HRRZ T,@6(T) ;WHAT A KLUDGE! 6?!!
046 142 014 CAIG R,POF
047 032 040 MOVEM T,PS.S
048 ] ;END OF IFN D10
049 048 005 JSP T,SPECBIND
050 TTYOFF
051 TAPWRT
052 Q% LPTON
053 002 039 IFN MOBIOF, DISPON
P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 142.1
054 V.RSET
055 10% V.NOPOINT ;FOR PPTBL
056 021 055 IFN USELESS, SETZM TYOSW
057 Q% MOVE T,VLINEL
058 Q% MOVEM T,VCHRCT
059 002 048 IFN QIO,[
060 HRRZ AR1,V%TYO ;UPDATE OUR NOTION OF THE
061 PUSHJ P,TTYBR1 ; LINENUM AND CHARPOS OF THE TTY,
062 018 057 MOVEI TT,AT.LNN ; SINCE DDT HAS SCREWED IT ALL UP.
063 181 046 HLRZM D,@TTSAR(AR1)
064 018 056 MOVEI TT,AT.CHS
065 181 046 HRRZM D,@TTSAR(AR1)
066 ] ;END OF IFN QIO
067
068 ;;; FALLS THRU
069
P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 143
001
002 ;;; FALLS IN
003
004 032 033 HRRZ T,POFF
005 142 017 10% CAIL T,PPTBL+1
006 146 005 10% JRST PPTBL1
007 032 037 MOVE T,PSMTS ;AT THIS POINT ALL ACS WILL HAVE BEEN
008 032 038 MOVE R,PSMRS ; RESTORED SO THAT MOVE A,@ WILL WORK.
009 032 035 MOVE A,PSMS
010 032 035 Q$ MOVE AR1,PSMS+AR1-A
011 032 040 MOVE A,@PS.S ;THUS THIS STUFF WORKS IF . IS AN AC.
012 032 033 HRRZ T,POFF
013 142 016 10% CAIN T,P%OFF+1
014 143 041 10% JRST PSYMP1
015 142 014 CAIN T,POF+1
016 142 013 MOVEI T,PSYM+1
017 142 015 CAIN T,TOF+1
018 142 011 MOVEI T,TSYM+1
019 142 007 SUBI T,SBSYM
020 TRNE T,1
021 TLZA A,-1
022 HLRZS A
023 LSH T,-1
024 209 011 JRST .+1(T)
025 143 053 JRST PSYMSB ;SB.$X
026 144 025 JRST PSYMVC ;VC.$X AND VCL.$X
027 145 046 JRST PSYMT ;T.$X AND TL.$X AND TP FOO$X
028 PSYMP: PUSHJ P,PRIN1 ;P.$X AND PL.$X AND PP FOO$X
029 PSYMQ: MOVEI A,TRUTH ;RETURN POINT TO GET OUT OF PSYM1
030 209 011 JRST ERR2
031 145 015 PSYMX: MOVEI T,LPSMTB
032 032 035 MOVE R,PSMS-1(T)
033 145 006 MOVEM R,@PSMTB-1(T)
034 SOJN T,.-2
035 032 037 MOVE T,PSMTS
036 032 038 MOVE R,PSMRS
037 032 032 SETZM PSYMF
038 143 031 CPSYMX: POPJ P,PSYMX
039
040 002 026 IFN ITS,[
041 PSYMP1: TLNN A,-1 ;LISP MODE TYPEOUT - HACK TWO HALVES
042 143 028 JRST PSYMP
043 PUSH P,A
044 HLRZ A,A
045 PUSHJ P,PRIN1
046 MOVEI A,", ;SEPARATE HALVES WITH ",,"
047 REPEAT 2, PUSHJ P,TYO
048 POP P,A
049 TLZ A,-1
050 143 028 JRST PSYMP
051 ] ;END OF IFN ITS
052
053 PSYMSB: MOVEI B,(A)
P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 143.1
054 PUSHJ P,ERRADR ;ERRADR DOES ALL THE DIRTY WORK!
055 143 029 JRST PSYMQ
056
057 Q% FCN.H: ;FAKE CONTROL-H INTERRUPT FROM DDT
058 Q$ FCN.B: ;FAKE CONTROL-B INTERRUPT FROM DDT
059 020 032 Q% SKIPN INHIBIT
060 015 019 SKIPE NOQUIT
061 POPJ P,
062 015 012 SKIPGE INTFLG
063 POPJ P,
064 002 048 IFE QIO,[
065 PUSH P,A
066 MOVEI A,1
067 196 007 PUSHJ P,UINT
068 059 035 JRST POPAJ
069 ] ;END OF IFE QIO
070
071 ;;; FALLS THRU
072
P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 144
001
002
003 ;;; FALLS IN
004 002 048 IFN QIO,[
005 181 046 PUSH FXP,D
006 020 032 MOVE D,INHIBIT ;CROCK SO THAT A .5LOCKI
007 059 057 AOJE D,POPXDJ ; WON'T STOP US
008 020 032 PUSH FXP,INHIBIT
009 020 032 SETZM INHIBIT
010 181 046 MOVE D,[TTYIFA,,400000+↑B]
011 196 007 PUSHJ P,UINT
012 020 032 POP FXP,INHIBIT
013 181 046 POP FXP,D
014 POPJ P,
015 ] ;END OF IFN QIO
016
017 142 015 TOF1: SKIPA T,[TOF]
018 142 014 POF1: MOVEI T,POF
019 022 058 PUSH P,UUOH
020 022 063 EXCH T,UUTSV
021 022 063 JRST @UUTSV
022
023
024
025 PSYMVC: MOVEI T,(A)
026 MOVEI A,QUNBOUND
027 CAIN T,SUNBOUND
028 143 028 JRST PSYMP
029 SKOTT T,LS
030 144 033 JRST PSVC1
031 071 024 JSP R,GCGEN
032 144 036 PSVC2
033 PSVC1: MOVEI A,QM
034 143 028 JRST PSYMP
035
036 181 046 PSVC2: HLRZ A,(D)
037 HLRZ B,(A)
038 HRRZ A,(B)
039 CAIN A,(T)
040 144 045 JRST PSVC3
041 181 046 HRRZ D,(D)
042 144 036 JUMPN D,PSVC2
043 209 011 JRST GCP8A
044
045 181 046 PSVC3: HLRZ A,(D)
046 143 028 JRST PSYMP
047
048 002 026 IFN ITS,[
049 145 017 PUFY: .BREAK 12,PSMST
050 032 040 MOVEI TT,@PS.S ;PURIFY THE PAGE THAT . IS ON
051 MOVE TT+1,TT ;USED BY DP}X AND RP}X
052 142 006 MOVEI C,-REPURE(T)
053 071 024 JSP R,IP0
P.$X AND FRIENDS LISP.393[MAC,LSP] 01/17/78 Page 144.1
054 143 031 JRST PSYMX
055 ] ;END IFN ITS
T.$X AND TBLPUR$X STUFF LISP.393[MAC,LSP] 01/17/78 Page 145
001
002
003 ;;; TABLE OF CELLS TO SAVE OVER THE PSYM FUNCTIONS
004
005 ZZ==. ;BE SURE TO SEE PSMS IF YOU CHANGE THIS TABLE
006 PSMTB: ;ACCUMULATOR A MUST BE THE FIRST ITEM, AND AR1 THE FOURTH
007 020 062 IRP FOO,,[A,B,C,AR1,AR2A,TT,D,F,40,UUOH,UUTSV,UUTTSV,UURSV,ERBDF,FPTEM]
008 004 056 FOO
009 TERMIN
010 002 051 IFN USELESS,[
011 021 038 PRINLV
012 021 055 TYOSW
013 021 046 ABBRSW
014 ] ;END OF IFN USELESS
015 035 033 LPSMTB==.-ZZ ;FPTEM AND PCNT ARE SAME LOCATION
016
017 032 040 IT$ PSMST: 4,,PS.S-1 ;READ VALUE OF . FROM DDT WITH .BREAK 12,
018
019 ; PP - A UUO ;PP IS FOR PRINTING OUT AN ADDRESS AS AN S-EXPRESSION:
020 ;PP 34722$X IN DDT WILL PRINT OUT 34722 AS A
021 ; POINTER IN LIST FORMAT.
022 ; TP - A UUO ;TP IS LIKE PP BUT NICELY PRINTS ST ENTRY FOR
023 ; THAT CELL
024 142 013 P.=PUSHJ P,PSYM ;P.$X IS LIKE PP FOO$X WHERE FOO IS RH OF.
025 142 012 PL.=PUSHJ P,PLSYM ;LIKE P., BUT FOR LH OF CURRENT CELL
026 142 016 IT$ P%=PUSHJ P,P%OFF ;LIKE P., BUT AS A DDT TYPEOUT MODE
027 142 009 VC.=PUSHJ P,VCSYM ;FIND NAME OF VALUE CELL RH OF . ADDRESSES
028 142 008 VCL.=PUSHJ P,VCLSYM ;A CROSS BETWEEN VC. AND PL.
029 142 011 T.=PUSHJ P,TSYM ;A CROSS BETWEEN P. AND TP
030 142 010 TL.=PUSHJ P,TLSYM ;A CROSS BETWEEN PL. AND TP
031 142 007 SB.=PUSHJ P,SBSYM ;FIND NAME OF SUBR ADDRESSED BY RH OF .
032 142 017 10% TBLPUR=PUSHJ P,PPTBL ;PRINT OUT PURTBL IN NICE FORM
033 142 018 10% PAGPUR=PUSHJ P,PPPAG ;PRINT OUT ACTUAL STATUS OF PAGES
034 143 057 Q% HH=PUSHJ P,FCN.H ;FAKE CONTROL-H INTERRUPT FROM DDT
035 143 058 Q$ BB=PUSHJ P,FCN.B ;FAKE CONTROL-B INTERRUPT FROM DDT
036 142 005 10% DP=PUSHJ P,DEPURE ;DEPURIFY PAGE . IS ON
037 142 006 10% RP=PUSHJ P,REPURE ;REPURIFY PAGE . IS ON
038
039 ; ENDCODE [P.$X]
040
041
042
043
044 SUBTTL T.$X AND TBLPUR$X STUFF
045
046 PSYMT: PUSHJ P,ITERPRI ;T.$X TYPEOUT, ETC.
047 MOVEI TT,(A)
048 005 042 ROT TT,-SEGLOG
049 036 033 MOVE TT,ST(TT)
050 035 006 SETZB T,C
051 071 024 MOVNI R,22
052 PSYMT1: LSHC T,1
053 TRZN T,1
T.$X AND TBLPUR$X STUFF LISP.393[MAC,LSP] 01/17/78 Page 145.1
054 145 066 JRST PSYMT3
055 MOVEI A,"+
056 035 006 TROE C,1
057 PUSHJ P,TYO
058 145 075 MOVEI B,PSYMTT+22(R)
059 145 075 CAIL B,PSYMTT+PSYMTL
060 MOVEI B,[ASCII \??\]
061 HRLI B,440700
062 PSYMT2: ILDB A,B
063 145 066 JUMPE A,PSYMT3
064 PUSHJ P,TYO
065 145 062 JRST PSYMT2
066 145 052 PSYMT3: AOJL R,PSYMT1
067 MOVEI A,",
068 REPEAT 2, PUSHJ P,TYO
069 HLRZ A,TT
070 PUSHJ P,PRINC
071 143 029 JRST PSYMQ
072
073 .SEE LS ;THIS TABLE SHOULD BE KEPT CONSISTENT
074 036 033 .SEE ST ; WITH TWO OTHER PLACES
075 PSYMTT:
076 IRP TP,,[LS,$FS,FX,FL,BN,SY,SA,VC,$PDLNM,??,$XM,$NXM,PUR,HNK,DB,CX,DX]
077 ASCII \TP\
078 TERMIN
079 145 075 PSYMTL==.-PSYMTT
T.$X AND TBLPUR$X STUFF LISP.393[MAC,LSP] 01/17/78 Page 146
001
002
003 002 026 IFN ITS,[
004
005 142 017 PPTBL1: MOVEI F,-PPTBL-1(T) ;0 => TBLPUR$X, 1 => PAGPUR$X
006 JSP T,0PUSH-4
007 034 035 MOVE R,[440200,,PURTBL]
008 MOVEI T,1
009 071 024 PPTBL2: ILDB TT,R
010 146 017 JUMPE F,PPTBL6
011 146 058 .CALL PPTBL8
012 .VALUE
013 ASH TT,-41
014 TRZ TT,1
015 SKIPGE TT
016 MOVEI TT,1 ;0=NONX, 1=IMPURE, 2=PURE
017 PPTBL6: MOVEI A,(FXP)
018 SUBI A,(TT)
019 AOS (A)
020 MOVEI A,"0(TT)
021 PUSHJ P,TYO
022 TRNE T,7
023 146 009 AOJA T,PPTBL2
024 TRNN T,30
025 146 033 JRST PPTBL3
026 MOVEI A,40
027 PUSHJ P,TYO
028 TRNE T,10
029 146 009 AOJA T,PPTBL2
030 PUSHJ P,TYO
031 PUSHJ P,TYO
032 146 039 JRST PPTBL4
033 PPTBL3:
034 Q$ PUSH FXP,T
035 PUSHJ P,ITERPRI
036 Q$ POP FXP,T
037 007 036 CAIN T,NPAGS
038 146 042 JRST PPTBL5
039 071 024 PPTBL4: TLZ R,770000
040 146 009 AOJA T,PPTBL2
041
042 071 024 PPTBL5: MOVEI R,TYO
043 MOVNI TT,4
044 PPTBL7: EXCH TT,(FXP)
045 146 055 JUMPE TT,PPTBL9
046 MOVEI A,↑I
047 PUSHJ P,TYO
048 MOVE A,(FXP)
049 ADDI A,"4
050 PUSHJ P,TYO
051 %NEG%
052 035 006 MOVEI C,10.
053 PUSHJ P,PRINI2
T.$X AND TBLPUR$X STUFF LISP.393[MAC,LSP] 01/17/78 Page 146.1
054 POP FXP,TT
055 146 044 PPTBL9: AOJL TT,PPTBL7
056 143 029 JRST PSYMQ
057
058 131 052 PPTBL8: SETZ
059 SIXBIT \CORTYP\
060 1000,,-1(T)
061 402000,,TT
062
063 ] ;END OF IFN ITS
PURIFY}G ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 147
001
002 SUBTTL PURIFY}G ROUTINE
003
004 005 006 IFN ITS+D20,[ ;DOESN'T REALLY WORK FOR D10 YET
005
006 209 011 PURIFY: JRST NOTINIT ;CLOBBERED BY INIT TO "SETO AR1,"
007 ; SETO AR1, ;FOR PURIFY$G FROM DDT
008 015 052 MOVE P,[-LFAKP-1,,FAKP-1]
009 015 053 Q% MOVE FXP,[-LFAKFXP-1,,FAKFXP-1]
010 209 011 JRST FPURF7
011
012 026 019 FPURF2: SETZB TT,PRSGLK ;ZERO PURE SEGMENT AOBJN PTR
013 023 035 MOVE R,[NPFFS,,NPFFS+1] ;ZERO PURE FREE STORAGE COUNTERS
014 071 024 SETZM (R)
015 023 046 BLT R,NPFFY2
016 071 024 MOVSI R,400000
017 029 028 SKIPE LDXBLT ;IF ANY XCT CALL AREA, WILL
018 029 029 IORM R,LDXSIZ ; PURIFY, HENCE CAN ADD NO CALLS
019 20$ MOVSI TT,.FHSLF
020 007 036 MOVNI R,NPAGS ;SO STEP THROUGH LOSING PURTBL
021 034 035 MOVE D,[440200,,PURTBL] ; TO DECIDE HOW TO MUNG PAGES
022 181 046 IPUR1: ILDB T,D ;GET BYTE FOR NEXT PAGE
023 209 011 JRST .+1(T)
024 148 011 JRST IPUR3 ;0 - DELETE
025 148 027 JRST IPUR4 ;1 - IMPURIFY
026 148 061 JRST IPUR6 ;2 - PURIFY
027 071 024 MOVEI T,400(R) ;3 - HAIRY STUFF - DECODE FURTHER
028 007 028 LSH T,PAGLOG
029 027 008 CAMGE T,BPSL ;CODE 3 SHOULD NEVER APPEAR
030 .VALUE ; BELOW BINARY PROGRAM SPACE
031 MOVE F,@VBPORG ;PAGIFY CURRENT VALUE OF
032 007 034 ANDI F,PAGMSK ; BPORG DOWNWARD
033 CAIGE T,(F) ;ANY CODE 3 PAGE BELOW THAT CAN
034 148 059 JRST IPUR6A ; BE PURIFIED
035 027 004 CAMG T,BPSH ;ANY CODE 3 PAGE BETWEEN BPORG
036 147 045 JRST IPUR2 ; AND BPSH IS LEFT AS IS
037 027 011 CAMG T,HINXM ;ANY PAGE BETWEEN BPSH AND HINXM
038 .VALUE ; DAMN WELL BETTER BE 0!!!
039 027 028 HRRZ F,PDLFL1 ;ANYTHING BETWEEN HINXM AND
040 007 028 LSH F,PAGLOG ; PDLS MUST BE PURE FREE STORAGE
041 CAIGE T,(F)
042 148 059 JRST IPUR6A
043 CAIGE T,BSCRSG ;SCRATCH PAGES ARE IGNORED
044 148 008 JUMPL AR1,IPUR3A ;PDL PAGES MAY OR MAY NOT BE FLUSHED, DEPENDING ON AR1
045 IPUR2:
046 IT$ ADDI TT,1001
047 20$ ADDI TT,1
048 181 046 TLNN D,730000 ;ONLY 20 2-BIT BYTES PER WORD, NOT 22
049 181 046 TLZ D,770000
050 147 022 AOJL R,IPUR1
051 035 006 20$ SETZB B,C ;ZERO OUT CRUD
052 MOVEI A,TRUTH
053 059 040 JUMPGE AR1,POP1J
PURIFY}G ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 147.1
054 009 047 MOVE T,[STDMSK]
055 015 046 MOVEM T,IMASK
056 181 032 Q$ IT$ MOVE T,[STDMS2]
057 015 047 Q$ IT$ MOVEM T,IMASK2
058 002 026 IFN ITS,[
059 .VALUE [ASCIZ \:}PURIFIED}
060 \]
061 209 011 JRST .-1
062 ] ;END OF IFN ITS
063 005 006 IFN D20,[
064 HRROI 1,[ASCIZ \:$PURIFIED$
065 \]
066 PSOUT
067 HALTF
068 209 011 JRST .-3
069 ] ;END OF IFN D20
PURIFY}G ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 148
001
002 ;;; IFN ITS+D20
003
004 ;;; VARIOUS PAGE FLUSHING AND PURIFYING ROUTINES FOR PURIFY
005
006 ;DELETE A PAGE
007
008 032 051 IPUR3A: SKIPE NOPFLS ;NOPFLS NON-ZERO => DON'T FLUSH PAGES
009 147 045 JRST IPUR2
010 181 046 DPB NIL,D ;ZERO OUT PURTBL ENTRY
011 IPUR3:
012 002 026 IFN ITS,[
013 TRZ TT,400000
014 .CBLK TT,
015 .VALUE
016 ] ;END OF IFN ITS
017 005 006 IFN D20,[
018 SETO 1,
019 MOVE 2,TT
020 131 052 SETZ 3,
021 PMAP
022 ] ;END OF IFN D20
023 147 045 JRST IPUR2
024
025 ;MAKE PAGE WRITABLE
026
027 IPUR4:
028 002 026 IFN ITS,[
029 .CALL IPUR9 ;CHECK TYPE OF PAGE
030 .VALUE
031 147 045 JUMPL T,IPUR2 ;ALREADY IMPURE
032 IOR TT,[4400,,400000]
033 148 038 JUMPG T,IPUR5
034 .CBLK TT, ;NON-EXISTENT - GET A FRESH PAGE
035 .VALUE
036 147 045 JRST IPUR2
037
038 IPUR5: TLZ TT,4000 ;PURE - TRY TO DEPURIFY
039 .CBLK TT,
040 JSP F,IP1 ;IF WE LOSE, TRY COPYING
041 ] ;END OF IFN ITS
042 005 006 IFN D20,[
043 MOVE 1,TT
044 RPACS
045 TLC 2,(PA%RD+PA%EX+PA%CPY)
046 TLNN 2,(PA%RD+PA%EX+PA%CPY+PA%WR)
047 147 045 JRST IPUR2
048 MOVE 1,TT
049 TLNN 2,(PA%EX)
050 TRZ 1,-1 ;?
051 MOVE 2,TT
052 MOVSI 3,(PM%RD+PM%EX+PM%CPY)
053 PMAP
PURIFY}G ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 148.1
054 ] ;END OF IFN D20
055 147 045 JRST IPUR2
056
057 ;MAKE PAGE READ-ONLY
058
059 IPUR6A: MOVEI T,2 ;CHANGE PURTBL ENTRY TO 2
060 181 046 DPB T,D
061 IPUR6:
062 002 026 IFN ITS,[
063 .CALL IPUR9 ;CHECK TYPE OF PAGE
064 .VALUE
065 147 045 JUMPG T,IPUR2 ;ALREADY PURE
066 148 070 JUMPE T,IPUR7 ;CAN'T PURIFY A NON-EXISTENT PAGE
067 TLZ TT,4400 ;PURIFY AN IMPURE PAGE
068 TRO TT,400000
069 .CBLK TT,
070 IPUR7: .VALUE
071 ] ;END OF IFN ITS
072 005 006 IFN D20,[
073 MOVE 1,TT
074 RPACS
075 TLNN 2,(PA%PEX)
076 006 115 HALT
077 TLNN 2,(PA%WR+PA%CPY)
078 147 045 JRST IPUR2
079 MOVE 1,TT
080 MOVE 2,TT
081 MOVSI 3,(PM%RD+PM%EX) ;ONLY RIGHT TO READ, NOT WRITE
082 PMAP
083 ] ;END OF IFN D20
084 147 045 JRST IPUR2
085
086 ] ;END OF IFN ITS+D20
087
088
089 002 042 IFN EDFLAG,[
090 006 006 $INSRT EDITOR ;KLUDGY BINFORD EDITOR
091 ]
PURE COPY OF THE READ SYNTAX TABLE LISP.393[MAC,LSP] 01/17/78 Page 149
001
002 SUBTTL PURE COPY OF THE READ SYNTAX TABLE
003
004
005 -1,,0 ;FOR NEWRD WILL POINT TO MACRO CHAR LIST
006 064 007 RSXTB2: PUSH P,CFIX1
007 JSP TT,1DIMF
008 NIL ;SHOULD NEVER ACTUALLY CALL
009 0
010 RCT0:
011 002 047 IFE NEWRD,[ ;OLD VERSION OF PURE READTABLE
012 002 029 IFN SAIL,[
013 REPEAT 11, 2,,.RPCNT ;SAIL CHARS
014 500500,,↑I ;TAB
015 500500,,↑J
016 400500,,↑K
017 400500,,↑L
018 400500,,↑M ;CR
019 220 022 REPEAT 22, 2,,↑N+.RPCNT ;SAIL CHARS
020 ] ;END IFN SAIL
021 .ELSE,[
022 REPEAT 10, 400500,,.RPCNT ;↑@ ↑A ↑B ↑C ↑D ↑E ;↑F ↑G
023 Q% 400500,,↑H ;↑H
024 Q$ 2,,↑H ;↑H
025 500500,,↑I ;TAB
026 REPEAT 7, 400500,,↑J+.RPCNT ;↑J ↑K ↑L ↑M ↑N ↑O ↑P
027 Q% 400500,,↑Q ;↑Q
028 Q$ 405540,,QCTRLQ ;↑Q
029 071 024 400500,,↑R ;↑R
030 Q% 400500,,↑S ;↑S
031 Q$ 405540,,QCTRLS ;↑S
032 REPEAT 7, 400500,,↑T+.RPCNT ;WORTHLESS
033 2,,33 ;ALT MODE
034 REPEAT 4, 400500,,↑\+.RPCNT ;WORTHLESS
035 ] ;END IFE SAIL
036 500500,,40 ;SPACE
037 REPEAT 6, 2,,"!+.RPCNT ;! " # $ % &
038 404500,,QRDQTE ;'
039 440500,,"( ;(
040 410500,,") ;)
041 2,,"* ;*
042 10,,"+ ;+
043 500500,,", ;,
044 50,,"- ;-
045 420700,,". ;.
046 402500,,"/ ;/
047 REPEAT 10., 4,,"0+.RPCNT ;DECIMAL DIGITS
048 2,,": ;:
049 404540,,QRDSEMI ;;
050 REPEAT 5, 2,,"<+.RPCNT ;< = > ? @
051 REPEAT 26., 1,,"A+.RPCNT ;ALPHABETIC
052 REPEAT 3, 2,,133+.RPCNT ;[ \ ]
053 22,,"↑ ;↑
PURE COPY OF THE READ SYNTAX TABLE LISP.393[MAC,LSP] 01/17/78 Page 149.1
054 62,,"← ;←
055 2,,"` ;ACCENT GRAVE
056 REPEAT 26., 501,,"A+.RPCNT ;SMALL LETTERS
057 2,,173 ;LEFT BRACE
058 404500,,QRDVBAR ;VERTICAL BAR
059 REPEAT 2, 2,,175+.RPCNT ;RIGHT BRACE, TILDE
060 401500,,177 ;RUBOUT
061 149 010 IFN .-RCT0-200, WARN [READTABLE LOSSAGE]
062 402500,,57 ;PSEUDO SLASHIFIER CHARACTER
063 440500,,50 ;PSEUDO OPEN PARENS
064 410500,,51 ;PSEUDO CLOSE PARENS
065 500540,,40 ;PSEUDO SPACE
066 SA$ REPEAT 574, 400500,,204+.RPCNT ;SAIL CONTROL CHARS
067 ] ;END OF IFE NEWRD
068
069 ;;; MORE ON NEXT PAGE
PURE COPY OF THE READ SYNTAX TABLE LISP.393[MAC,LSP] 01/17/78 Page 150
001
002 002 047 IFN NEWRD,[ ;NEW VERSION OF PURE READTABLE
003
004 REPEAT 11, RS.BRK+RS.SL1+RS.SL9 + .RPCNT ;WORTHLESS CONTROL CHARS
005 RS.BRK+RS.SL1+RS.SL9+RS.WSP + 11 ;TAB
006 REPEAT 21, RS.BRK+RS.SL1+RS.SL9 + 12+.RPCNT ;WORTHLESS
007 RS.XLT + 33 ;ALTMODE
008 REPEAT 4, RS.BRK+RS.SL1+RS.SL9 + 34+.RPCNT ;WORTHLESS
009 RS.BRK+RS.SL1+RS.SL9+RS.WSP + 40 ;SPACE
010 REPEAT 6, RS.XLT + 41+.RPCNT ;! " # $ % &
011 RS.BRK+RS.SL1+RS.SL9+RS.MAC + 47 ;'
012 RS.BRK+RS.SL1+RS.SL9+RS.LP + 50 ;(
013 RS.BRK+RS.SL1+RS.SL9+RS.RP + 51 ;)
014 RS.XLT + 52 ;*
015 RS.SL1+RS.SGN + 53 ;+
016 RS.BRK+RS.SL1+RS.SL9+RS.WSP + 54 ;,
017 RS.SL1+RS.SGN+RS.ALT + 55 ;-
018 RS.BRK+RS.SL1+RS.SL9+RS.DOT+RS.PNT + 56 ;.
019 RS.BRK+RS.SL1+RS.SL9+RS.SLS + 57 ;/
020 REPEAT 10., RS.SL1+RS.DIG + 60+.RPCNT ;0 - 9
021 RS.XLT + 72 ;:
022 RS.BRK+RS.SL1+RS.SL9+RS.MAC+RS.ALT + 73 ;;
023 REPEAT 5, RS.XLT + 74+.RPCNT ;< = > ? @
024 REPEAT 4, RS.LTR + 101+.RPCNT ;A-D
025 RS.LTR + RS.SQX + 105 ;E
026 REPEAT 21., RS.LTR + 106+.RPCNT ;F-Z
027 REPEAT 3, RS.XLT + 133+.RPCNT ;LBRACK BSLASH RBRACK
028 RS.ARR+RS.XLT + 136 ;↑
029 RS.ARR+RS.ALT+RS.XLT + 137 ;←
030 RS.XLT + 140 ;ACCENT GRAVE
031 REPEAT 4, RS.LTR + 101+.RPCNT ;A-D L.C.
032 RS.LTR+RS.SQX + 105 ;E L.C.
033 REPEAT 21., RS.LTR + 106+.RPCNT ;F-Z L.C.
034 REPEAT 4, RS.XLT + 173+.RPCNT ;LBRACE VBAR RBRACE TILDE
035 RS.BRK+RS.SL1+RS.SL9+RS.RBO + 177 ;RUBOUT
036 RS.BRK+RS.SL1+RS.SL9+RS.SLS + 57 ;PSEUDO SLASH
037 RS.BRK+RS.SL1+RS.SL9+RS.LP + 50 ;PSEUDO (
038 RS.BRK+RS.SL1+RS.SL9+RS.RP + 51 ;PSEUDO )
039 RS.BRK+RS.SL1+RS.SL9+RS.WSP + 40 ;PSEUDO SPACE
040 ] ;END OF IFN NEWRD
041
042
043 149 010 TLRCT==<.-RCT0>
044 007 017 SA$ INFORM READTABLE-LENGTH,\<LRCT>
045 007 017 ZZ==LRCT-TLRCT
046 002 047 IFE NEWRD,[
047 035 033 IFL ZZ-1-2, INFORM READER-TABLE-DEFICIENCY,\<3-ZZ>
048 035 033 .ELSE BLOCK ZZ-3
049 ] ;END OF IFE NEWRD
050
051 NIL,,NIL ;UNUSED
052 TRUTH,,0 ;(STATUS TTYREAD),,(STATUS ABBREVIATE)
053 NIL,,TRUTH ;(STATUS TERPRI),,(STATUS ←)
PURE COPY OF THE READ SYNTAX TABLE LISP.393[MAC,LSP] 01/17/78 Page 150.1
054
055 ;;; TTYREAD=NIL => ONLY FORCE FEED CHARS LET READ SEE THE TTY BUFFER
056 ;;; ABBREVIATE: 1.1 => ABBREV FILES, 1.2 => ABBREV FLATSIZE/EXPLODE
057 ;;; TERPRI=T => DO NOT OUTPUT AUTOMATIC NEWLINES
058 ;;; ←=T => ALLOW PRIN1/PRINC TO OUTPUT FIXNUMS IN FORM M←N
TOP PAGE PGTOP, AND SOME INSRTS LISP.393[MAC,LSP] 01/17/78 Page 151
001
002
003 SUBTTL TOP PAGE PGTOP, AND SOME INSRTS
004
005 MOVEI 1,[.] ;THIS WASTEFUL HAC IS MERELY TO INSURE THAT THE LAST
006 MOVEI 2,[.] ;FEW CONSTANTS ON THIS PART ARE WORTHLESS
007 MOVEI 3,[.] ;IN CASE THERE ARE MORE ON PASS2 THAN PASS1
008
009 PGTOP TOP,[TOPLEVEL, COMMON, AND RANDOM STUFF]
010
011
012 ;;; HERE IS A SUNDER HAC - IT MUST BE ABLE TO FIND
013 ;;; <LF>$INSRT<SP>NAME<TABS-OR-SPACES>;COMMENTS ON FILE
014
015 002 039 IFN MOBIOF,[
016 006 006 $INSRT MOBYIO ;MOBY I/O PACKAGE
017 ]
018
019 006 006 $INSRT PRINT ;PRINT AND FILE-HANDLING FUNCTIONS
020
021 006 006 $INSRT ULAP ;UTAPE, LAP, AND AGGLOMERATED SUBRS
022
023
024 006 006 $INSRT ARITH ;STANDARD ARITHMETIC FUNCTIONS
025
026 ;;; REMEMBER THE SUNDER HACK, AND DONT HACK THIS $INSRT
027 002 041 IFN BIGNUM,[
028 002 041 $INSRT BIGNUM ;BIGNUM ARITHMETIC PACKAGE
029 ]
030
EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 152
001
002 SUBTTL EVAL AND EVALHOOK
003
004 PGBOT EVL
005
006
007
008 EVALHOOK:
009 057 027 JSP TT,LWNACK
010 LA23,,QEVALHOOK
011 002 046 IFE FUNAFL,[
012 181 046 MOVEI D,QEVALHOOK
013 064 014 CAME T,XC-2
014 209 011 JRST WNALOSE
015 ] ;END OF IFE FUNAFL
016 POP P,B
017 181 046 AOS D,T
018 048 005 JSP T,SPECBIND
019 0 B,VEVALHOOK
020 002 046 IFN FUNAFL,[
021 064 014 CAMN D,XC-2
022 133 040 PUSHJ FXP,AEVAL ;SKIP RETURN
023 ] ;END OF IFN FUNAFL
024 POP P,A
025 164 094 PUSH P,CUNBIND
026 EVNH0: SKIPN V.RSET ;EVALUATE, BYPASSING HOOK CHECK
027 174 004 JRST EV0 .SEE STORE
028 152 052 JRST EVAL0
029
030 OEVAL:
031 002 046 IFN FUNAFL,[
032 057 027 JSP TT,LWNACK ;"EXTERNAL" EVAL - LSUBR (1 . 2)
033 LA12,,QOEVAL ;MAY TAKE ALIST AS SECOND ARG
034 064 014 CAMN T,XC-2
035 133 040 PUSHJ FXP,AEVAL ;SKIP RETURN
036 ] ;END OF IFN FUNAFL
037 002 046 IFE FUNAFL,[
038 AOJE T,.+3
039 181 046 MOVEI D,QOEVAL
040 SOJA T,WNALOSE
041 ] ;END OF IFE FUNAFL
042 POP P,A
043 EVAL: SKIPN V.RSET ;"INTERNAL" EVAL - ARG IN A
044 153 006 JRST EV0
045 SKIPN B,VEVALHOOK
046 152 052 JRST EVAL0
047 048 005 JSP T,SPECBIND ;SUPER-RANDOM HACK SO THAT MM
048 VEVALHOOK ; CAN INVENT A ↑N FOR LISP
049 CALLF 1,(B)
050 049 033 JRST UNBIND
051
052 EVAL0: SKIPE NIL ;RANDOM PLACE TO CHECK FOR NIL CLOBBERED
053 043 024 PUSHJ P,NILBAD
EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 152.1
054 PUSH P,FXP ;EVAL FRAME FORMAT:
055 HRLM FLP,(P) ; FLP,,FXP
056 PUSH P,A ; SP,,<FORM>
057 HRLM SP,(P) ; $EVALFRAME
058 061 005 PUSH P,[$EVALFRAME] ;SEE APPLY FOR FORMAT OF APPLY FRAMES
059
060 ;FALLS THROUGH
EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 153
001
002 ;FALLS IN
003
004 ;;; EVALUATE A FORM IN A
005
006 059 031 EV0: JUMPE A,CPOPJ ;NIL => NIL, ALWAYS!!!
007 068 038 MOVEI C,ILIST
008 SKOTT A,LS
009 036 038 2DIF JRST (TT),EVTB1-1,QLIST .SEE STDISP
010 EV0A: MOVE AR1,(A) ;FUNCTION ON 0(P), ADDRESS TO JRST TO IN (TT)
011 HLRZ T,(A)
012 SKOTT T,LS
013 036 038 2DIF JRST (TT),EVTB2-1,QLIST .SEE STDISP
014 HLRZ TT,(T)
015 CAIN TT,QLAMBDA
016 155 012 JRST EXP3
017 002 046 IFN FUNAFL,[
018 CAIE TT,QFUNARG
019 CAIN TT,QLABEL
020 155 012 JRST EXP3
021 ] ;END OF IFN FUNAFL
022 035 006 JUMPL C,EV3B
023 SKIPE B,VOEVAL
024 JCALLF 1,(B) ;EVALSHUNT
025 HLRZ A,AR1
026 035 006 TLNN C,777740 ;MAYBE SAVE FUNCTION NAME IN EV0B
027 021 006 MOVEM A,EV0B
028 021 006 PUSH P,EV0B ;NON-ATOMIC FUNCTION, NOT LAMBDA,
029 035 006 PUSH P,C ; LABEL, OR FUNARG
030 PUSH P,AR1
031 153 006 PUSHJ P,EV0 ;SO EVALUATE THE FORM
032 POP P,AR1
033 035 006 POP P,C
034 021 006 POP P,EV0B
035 156 039 JRST EV4 ;NOW TRY USING THE RESULT AS A FUNCTION
036
037 094 011 EVTB1: JRST PDLNKJ ;FIXNUMS EVALUATE TO THEMSELVES
038 094 011 JRST PDLNKJ ;DITTO FLONUMS
039 094 011 DB$ JRST PDLNKJ ;DITTO DOUBLES
040 094 011 CX$ JRST PDLNKJ ;DITTO COMPLEXES
041 094 011 DX$ JRST PDLNKJ ;DITTO DUPLEXES
042 BG$ POPJ P, ;GUESS WHAT, FELLAHS
043 154 002 JRST EE1 ;SOME HAIR FOR SYMBOLS
044 002 050 REPEAT HNKLOG, .VALUE ;HUNKS (SHOULD BE CAUGHT BEFORE THIS TABLE)
045 153 049 JRST EV2 ;RANDOMS LOSE
046 POPJ P, ;ARRAYS EVAL TO SELVES
047 153 037 IFN .-EVTB1-NTYPES+1, WARN [WRONG LENGTH TABLE]
048
049 EV2: %WTA EMS25 ;UNEVALUABLE DATUM (RANDOMNESS)
050 153 006 JRST EV0
051
052 209 011 EVTB2: JRST EV3A ;FIXNUM AS A FUNCTION IS AN ERROR
053 209 011 JRST EV3A ;DITTO FLONUM
EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 153.1
054 209 011 DB$ JRST EV3A ;DITTO DOUBLE
055 209 011 CX$ JRST EV3A ;DITTO COMPLEX
056 209 011 DX$ JRST EV3A ;DITTO DUPLEX
057 209 011 BG$ JRST EV3A ;DITTO BIGNUM
058 154 007 JRST EE2 ;SYMBOLS - THE GOOD CASE
059 002 050 REPEAT HNKLOG, .VALUE ;HUNKS
060 209 011 JRST EV3A ;IT'S A TRULY RANDOM FUNCTION!
061 155 039 JRST ESAR ;IT'S AN ARRAY
062 153 052 IFN .-EVTB2-NTYPES+1, WARN [WRONG LENGTH TABLE]
EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 154
001
002 157 015 EE1: PUSHJ P,EVSYM ;EVALUATE SYMBOL
003 POPJ P, ;WIN
004 153 006 JRST EV0 ;LOSE - RETRY
005
006
007 131 052 EE2: SETZ R, ;ZERO R FOR HACK TO TRAP AUTOLOAD LOSS
008 EE2A: HRRZ T,(T) ;CAR (X) IS ATOMIC
009 154 029 JUMPE T,EAL2 ;GET FUNCTION DEFINITION OFF ATOM
010 HLRZ TT,(T)
011 HRRZ T,(T)
012 CAIL TT,QARRAY ;SYMBOL HEADERS FOR FUNCTION MARKERS
013 CAILE TT,QAUTOLOAD ; ARE LINEAR IN MEMORY
014 154 008 JRST EE2A
015 154 017 2DIF JRST @(TT),ETT,QARRAY
016
017 155 040 ETT: EAR ;ARRAY
018 156 002 ESB ;SUBR
019 155 017 EFS ;FSUBR
020 155 021 ELSB ;LSUBR
021 155 010 AEXP ;EXPR
022 155 002 EFX ;FEXPR
023 154 038 EFM ;MACRO
024 154 026 EAL ;AUTOLOAD
025
026 071 024 EAL: HRRI R,(T) ;NOTE THAT WE SAW AUTOLOAD PROPERTY
027 154 008 JRST EE2A
028
029 071 024 EAL2: JUMPL R,EV3J ;FN UNDEF AFTER AUTOLOAD
030 156 031 JUMPE R,EV3 ;NO AUTOLOAD PROP - TRY EVALING ATOM
031 071 024 MOVEI B,(R)
032 HLRZ T,(A)
033 162 046 PUSHJ P,IIAL
034 HLRZ T,(A)
035 071 024 SETO R,
036 154 008 JRST EE2A
037
038 068 038 EFM: CAIE C,ILIST ;FOUND MACRO
039 EFMER: LERR EMS21 ;IMPROPER USE OF MACRO
040 MOVE B,AR1
041 HLRZ AR1,(T) ;COMMENT THIS CROCK
042 CAIN A,AR1
043 073 012 PUSHJ P,CONS1
044 CALLF 1,(AR1) ;SO HAND THE FORM TO THE MACRO
045 152 043 JRST EVAL ; AND RE-EVALUATE THE RESULT
EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 155
001
002 EFX: HLRZ T,(T) ;FOUND FEXPR
003 HLL T,AR1 ;SO A FEXPR BEHAVES LIKE AN EXPR
004 PUSH P,T ; WHOSE ONE ARG IS CDR OF THE FORM
005 164 097 HRLI AR1,400000 .SEE IAP4 ;FOR EXPLANATION OF THIS HACK
006 PUSH P,AR1 ; WHICH ALLOWS FEXPRS AN ALIST ARG
007 MOVNI T,1
008 161 015 JRST IAPPLY
009
010 AEXP: HLRZ T,(T) ;FOUND EXPR
011 HLL T,AR1
012 EXP3: PUSH P,T ;FOUND LAMBDA, LABEL, FUNARG
013 MOVEI A,(AR1)
014 161 015 CIAPPLY: MOVEI TT,IAPPLY
015 209 011 JRST (C)
016
017 EFS: HLRZ T,(T) ;FOUND FSUBR
018 156 016 MOVEI C,ESB3 ;THIS IS SO WE DON'T EVAL THE ARGS!
019 156 005 JRST ESB2
020
021 059 031 ELSB: PUSH P,CPOPJ ;FOUND LSUBR
022 HLLM AR1,(P)
023 071 024 MOVE R,T
024 071 024 HLL R,AR1
025 155 029 MOVEI TT,ELSB1
026 HRRZ A,AR1
027 209 011 JRST (C)
028
029 ELSB1: MOVEI A,NIL ;A HAS NIL WHEN ENTERING AN LSUBR
030 071 024 HLRZ D,(R)
031 SKIPN V.RSET
032 209 011 JRST (D)
033 071 024 HLRZ R,R
034 218 012 PUSHJ P,ARGCK0 ;CHECK OUT NUMBER OF ARGS
035 209 011 JRST ESB6
036 209 011 JRST (D)
037
038
039 ESAR: SKIPA TT,T ;FOUND SAR
040 EAR: HLRZ TT,(T) ;FOUND ARRAY
041 071 024 MOVEI R,(TT)
042 SKOTT TT,SA
043 209 011 JRST EV3A
044 071 024 EAR3: HRRZ T,ASAR(R)
045 CAIN T,ADEAD
046 209 011 JRST EV3A ;AHA! THIS ARRAY IS DEAD!
047 071 024 PUSH P,R
048 155 051 MOVEI T,EAR1 ;MUST DO SOME HAIR SO THAT
049 156 004 JRST ESB4 ; INTERRUPTS WON'T SCREW US
050
051 EAR1: MOVE T,LISAR ;DO NOT MERGE THIS WITH IAPAR1
052 156 016 JRST @ASAR(T) .SEE ESB3
EVAL AND EVALHOOK LISP.393[MAC,LSP] 01/17/78 Page 156
001
002 071 024 ESB: HLRZ R,AR1 ;FOUND SUBR
003 HLRZ T,(T)
004 156 010 ESB4: MOVEI TT,ESB1
005 ESB2: MOVEI A,(AR1) ;A GETS LIST OF ARGS
006 HLL T,AR1
007 PUSH P,T ;STORE ADDRESS OF SUBROUTINE FOR FN
008 209 011 JRST (C) ;GO SOMEWHERE OR OTHER
009
010 218 003 ESB1: PUSHJ P,ARGCHK
011 209 011 JRST ESB6
012 MOVE TT,[A,,A+1]
013 MOVEI A,Q..MIS
014 BLT TT,A+NACS-1
015 218 051 JSP R,PDLA2(T)
016 ESB3: HRRZ TT,(P)
017 155 051 CAIN TT,EAR1 ;HACK TO HELP EAR1 WIN
018 156 026 JRST ESB3C
019 ESB3A: SKIPN V.RSET
020 POPJ P, ;ADDRESS OF SUBR IS ON STACK
021 059 031 MOVEI TT,CPOPJ ;WELL, MAYBE DO SOME *RSET HAIR
022 HLL TT,(P)
023 EXCH TT,(P)
024 209 011 JRST (TT)
025
026 ESB3C: HRRZ TT,-1(P)
027 MOVEM TT,LISAR ;SAR PROTECTED BY BEING IN LISAR
028 POP P,-1(P)
029 156 019 JRST ESB3A
030
031 035 006 EV3: JUMPL C,EV3B ;C<0 => TOO MANY RE-EVALS OF A FN
032 HLRZ A,AR1
033 HLRZ A,(A)
034 HRRZ A,@(A) ;GET VALUE OF ATOMIC FUNCTION
035 CAIN A,QUNBOUND ;IT'S UNBOUND. LOSE, LOSE, LOSE...
036 209 011 JRST EV3A
037 035 006 TLNN C,777740 ;SAVE FN NAME IN EV0B, MAYBE
038 021 006 HLRZM AR1,EV0B
039 035 006 EV4: ADD C,[1←34.] ;THIS SIZE OF THIS QUANTITY CONSTRAINS
040 EV4B: HRL AR1,A ; THE # OF TIMES WE MAY RE-EVAL THE FN
041 MOVEI A,AR1
042 153 010 JRST EV0A
SYMEVAL LISP.393[MAC,LSP] 01/17/78 Page 157
001
002
003 SUBTTL SYMEVAL
004
005 SYMEV0: %WTA NASER
006 059 031 SYMEVAL: JUMPE A,CPOPJ ;SUBR 1
007 080 013 JSP T,SPATOM
008 157 005 JRST SYMEV0
009 157 015 PUSHJ P,EVSYM
010 POPJ P, ;WON
011 157 006 JRST SYMEVAL ;LOST
012
013 ;;; EVALUATE ATOMIC SYMBOL. SKIPS ON FAILURE (AFTER DOING ERROR).
014
015 EVSYM: HLRZ T,(A) ;T GETS POINTER TO SYMBOL BLOCK
016 HRRZ T,@(T) ;AR1 GETS VALUE FROM VALUE CELL!!!
017 CAIN T,QUNBOUND
018 157 022 JRST EE1A ;FOOBAR! VALUE CELL CONTAINS UNBOUND
019 MOVEI A,(T) ;SO THE VALUE IS THE RESULT OF EVAL
020 POPJ P,
021
022 EE1A: %UBV MES6 ;UNBOUND VAR
023 059 039 JRST POPJ1
024
025 ;;; END OF EVSYM ROUTINE
APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 158
001
002 SUBTTL APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL
003
004 064 014 APPLY: CAME T,XC-2 ;"EXTERNAL" APPLY - SUBR (2 . 3)
005 158 029 JRST AP4 ;MAY TAKE A THIRD ALIST ARG
006 218 051 JSP R,PDLA2(T)
007 .APPLY: ;SUBR 2 (*APPLY)
008 AP3: SKIPN V.RSET
009 158 016 JRST AP3A
010 PUSH P,B
011 PUSH P,FXP
012 HRLM FLP,(P)
013 PUSH P,A
014 HRLM SP,(P)
015 061 044 PUSH P,[$APPLYFRAME]
016 AP3A: MOVEI AR1,(B) ;"INTERNAL" APPLY -
017 HRL AR1,A ; FUNCTION IN A, LIST OF ARGS IN B
018 MOVEI A,AR1
019 158 022 MOVEI C,AP2 ;THIS CROCK LETS US SHARE CODE WITH
020 153 010 JRST EV0A ; EVAL BY PREVENTING EVAL'ING OF ARGS
021
022 AP2: MOVEI T,0 ;DE-LISTIFY THE ARGS AND STACK THEM
023 JUMPE A,(TT) ; ON THE PDL, AND ALSO COUNT THEM
024 PUSH P,(A) ;DOING THINGS THIS WAY AVOIDS
025 HLRZS (P) ; DESTROYING ANY OTHER ACS
026 HRRZ A,(A)
027 SOJA T,.-4
028
029 AP4:
030 002 046 IFN FUNAFL,[
031 057 027 JSP TT,LWNACK ;APPLY WITH AN ALIST (GOOD GRIEF!)
032 LA23,,QAPPLY
033 021 019 MOVEM T,APFNG1
034 SKIPE A,(P) ;PURPOSELY CRIPPLING THE POWER OF
035 065 007 JSP T,FXNV1 ; THE ALIST ROUTINE: FOOEY! - GLS
036 134 052 PUSHJ P,ALIST ;SO CREATE MORONIC ALIST ENVIRONMENT
037 021 019 EXCH T,APFNG1
038 218 051 JSP R,PDLA2(T)
039 021 019 SKIPE APFNG1 ;ALIST RETURNING NON-ZERO IN T =>
040 137 024 PUSH P,CAUNBIND ; TWO BIND BLOCKS WERE PUSHED
041 137 024 PUSH P,CAUNBIND
042 158 008 JRST AP3
043 ] ;END OF IFN FUNAFL
044 002 046 IFE FUNAFL,[
045 181 046 MOVEI D,QAPPLY
046 209 011 JRST WNALOSE
047 ] ;END OF IFE FUNAFL
APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 159
001
002 057 021 SUBRCALL: JSP TT,FWNACK ;LSUBR (2 . 7)
003 FA234567,,QSUBRCALL
004 068 035 JSP TT,JLIST
005 ADDI T,1
006 218 046 JSP R,PDLARG
007 POP P,TT
008 159 028 JSP D,PTRCHK
009 PUSHJ P,(TT)
010 181 046 RETTYP: POP P,D ;PURELY FOR TYPE CHECKING
011 181 046 CAIN D,QFIXNUM
012 065 007 JSP T,FXNV1
013 181 046 CAIN D,QFLONUM
014 065 029 JSP T,FLNV1
015 POPJ P,
016
017
018 057 021 %LSUBRCALL: JSP TT,FWNACK ;FSUBR
019 FA2N,,Q%LSUBRCALL
020 068 035 JSP TT,JLIST
021 181 046 MOVEI D,(P)
022 181 046 ADDI D,(T)
023 159 010 MOVEI TT,RETTYP
024 181 046 EXCH TT,1(D)
025 159 028 JSP D,PTRCHK
026 AOJA T,(TT)
027
028 PTRCHK: CAIL TT,BEGFUN
029 219 074 CAIL TT,ENDFUN
030 209 011 JRST .+2
031 209 011 JRST (D)
032 027 008 CAML TT,BPSL
033 CAML TT,@VBPORG
034 209 011 JRST PTRCKE
035 209 011 JRST (D)
036
APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 160
001
002
003 057 021 %ARRAYCALL: JSP TT,FWNACK ;FSUBR
004 FA76543,,Q%ARRAYCALL
005 068 035 JSP TT,JLIST
006 181 046 MOVEI D,(T)
007 181 046 ADDI D,(P) ;FALLS INTO FUNCALL
008 181 046 %ARR7: HRRZ A,1(D)
009 SKOTT A,SA
010 SOJA T,%ARR0
011 059 031 MOVEI B,CPOPJ
012 181 046 EXCH B,(D)
013 181 046 HLRZ TT,@1(D) .SEE ASAR
014 MOVEI F,AS<SX>
015 CAIN B,QFIXNUM
016 MOVEI F,AS<FX>
017 CAIN B,QFLONUM
018 MOVEI F,AS<FL>
019 TRNN TT,(F)
020 209 011 JRST %ARR0A
021 181 046 FUNCALL: MOVEI D,QFUNCALL ;LSUBR (1 . 777)
022 JUMPE T,WNALOSE ;(FUNCALL F X1 X2 ... XN) IS LIKE
023 FUNCA1: SKIPN V.RSET ; (APPLY F (LIST X1 X2 ... XN))
024 161 015 AOJA T,IAPPLY ;IN *RSET MODE, WE FAKE
025 ADDI T,1 ; OUT THE UUO STUFF
026 MOVEI TT,(P) ; INTO DOING THE APPLY
027 ADDI TT,(T) ; FRAME HACKERY FOR US
028 059 031 MOVEI B,CPOPJ
029 EXCH B,(TT)
030 JCALLF 16,(B)
APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 161
001
002 ;;; VERY INTERNAL APPLY, FOR USE PARTICULARLY WITH "CALL" UUO'S
003 ;;;
004 ;;; STATE OF WORLD AT ENTRANCE TO IAPPLY:
005 ;;; T HAS -<NUMBER OF ARGS ON PDL>.
006 ;;; PDL HAS ARGS ON IT; BELOW THEM IS A SLOT
007 ;;; WITH THE FUNCTION IN THE RIGHT HALF.
008 ;;; THE FUNCTION'S NAME IS MAYBE IN THE LEFT HALF.
009 ;;; C IS USED PRIMARILY TO POINT TO THIS LATTER SLOT; AND, AS
010 ;;; USUAL, THE LEFT HALF HELPS TO LIMIT FUNCTION RE-EVALS.
011 ;;; IF THERE IS ONLY ONE ARG ON THE STACK, 400000 IN THE LEFT
012 ;;; HALF OF THE PDL SLOT MEANS FUNCTION IS A FEXPR, AND MAY
013 ;;; THEREFORE TAKE AN EXTRA (A-LIST) ARGUMENT.
014
015 035 006 IAPPLY: MOVE C,T ;STATE OF WORLD AT ENTRANCE:
016 035 006 ADDI C,(P) ; T HAS -<NUMBER OF ARGS ON PDL>
017 035 006 ILP1: HRRZ A,(C) ; NEXT PDL SLOT HAS FUNCTION IN RH,
018 SKOTT A,LS
019 162 002 2DIF JRST (TT),APTB1-1,QLIST ;FN IS NOT LIST STRUCTURE
020 HRRZ B,(A)
021 HLRZ A,(A)
022 CAIN A,QLAMBDA
023 164 002 JRST IAPLMB ;IT'S A LAMBDA
024 002 046 IFN FUNAFL,[
025 CAIN A,QFUNARG
026 137 013 JRST APFNG ;IT'S A FUNARG (MORE GOOD GRIEF!)
027 CAIN A,QLABEL
028 137 033 JRST APLBL ;IT'S A LABEL (SUPER GOOD GRIEF!)
029 ] ;END OF IFN FUNAFL
030 035 006 PUSH P,C
031 PUSH FXP,T
032 035 006 HRRZ A,(C)
033 035 006 JUMPL C,IAP2A ;JUMP IF WE'VE RE-EVAL'ED TOO MUCH
034 153 006 PUSHJ P,EV0 ;ELSE EVAL THE FUNCTIONAL FORM
035 035 006 POP P,C ; AND TRY IT AGAIN...
036 POP FXP,T
037 035 006 ILP1B: MOVE B,(C)
038 035 006 HRRM A,(C)
039 TLNN B,-1
040 035 006 HRLM B,(C) ;PUTS FUNCTION NAME IN LH IF NOT THERE
041 035 006 TLO C,400000
042 161 017 JRST ILP1
APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 162
001
002 209 011 APTB1: JRST IAP2A ;FIXNUMS ARE NOT FUNCTIONS!
003 209 011 JRST IAP2A ;NOR FLONUMS
004 209 011 DB$ JRST IAP2A ;NOR DOUBLES
005 209 011 CX$ JRST IAP2A ;NOR COMPLEXES
006 209 011 DX$ JRST IAP2A ;NOR DUPLEXES
007 209 011 BG$ JRST IAP2A ;NOR BIGNUMS ALREADY
008 162 013 JRST IAPATM ;SYMBOLS ARE OKAY, BUT JUST BARELY
009 002 050 REPEAT HNKLOG, .VALUE ;HUNKS
010 209 011 JRST IAP2A ;TRUE RANDOMS ARE OUT!
011 162 051 JRST IAPSAR ;IT'S AN ARRAY - OKAY, I GUESS
012
013 IAPATM: HRRZ B,(A) ;APPLY GOT ATOMIC FUNCTION
014 035 006 HRRZS 1(C) ;KILL POSSIBLE 400000 BIT DUE TO FEXPR
015 071 024 TDZA R,R
016 IAPAT2: HRRZ B,(B)
017 162 037 IAPAT3: JUMPE B,IAPIA1 ;GRAB FUNCTION FROM PROP LIST
018 HLRZ TT,(B)
019 HRRZ B,(B)
020 CAIL TT,QARRAY ;REMEMBER, FUNCTION PROPS ARE
021 CAILE TT,QAUTOLOAD ; LINEAR IN MEMORY
022 162 016 JRST IAPAT2
023 162 025 2DIF JRST @(TT),IATT,QARRAY
024
025 162 052 IATT: IAPARR ;ARRAY
026 162 058 IAPSBR ;SUBR
027 162 058 IAPSBR ;FSUBR
028 163 005 IAPLSB ;LSUBR
029 163 002 IAPXPR ;EXPR
030 163 002 IAPXPR ;FEXPR
031 162 016 IAPAT2 ;IGNORE MACROS
032 162 034 IAPIAL ;AUTOLOAD
033
034 071 024 IAPIAL: HRRI R,(B)
035 162 016 JRST IAPAT2
036
037 071 024 IAPIA1: JUMPL R,IAP2J
038 163 010 JUMPE R,IAP2
039 071 024 MOVEI B,(R)
040 MOVEI T,(A)
041 162 046 PUSHJ P,IIAL
042 HRRZ B,(A)
043 071 024 SETO R,
044 162 017 JRST IAPAT3
045
046 IIAL: PUSH P,A
047 HLRZ A,(B)
048 129 031 PUSHJ P,AUTOLOAD
049 059 035 JRST POPAJ
050
051 IAPSAR: SKIPA TT,A ;APPLY A SAR
052 IAPARR: HLRZ TT,(B) ;APPLY AN ARRAY
053 MOVEM TT,LISAR ;FOR INTERRUPT PROTECTION ONLY
APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 162.1
054 071 024 MOVEI R,(T)
055 162 063 MOVEI TT,IAPAR1
056 162 060 JRST IAPSB1
057
058 IAPSBR: HLRZ TT,(B) ;APPLY A SUBR
059 035 006 HRRZ R,(C)
060 035 006 IAPSB1: HRRM TT,(C)
061 156 010 JRST ESB1
062
063 IAPAR1: MOVE TT,LISAR
064 209 011 JRST @ASAR(TT)
APPLY, *APPLY, SUBRCALL, LSUBRCALL, ARRAYCALL, FUNCALL LISP.393[MAC,LSP] 01/17/78 Page 163
001
002 IAPXPR: HLRZ A,(B)
003 161 037 JRST ILP1B
004
005 059 031 IAPLSB: MOVEI TT,CPOPJ
006 035 006 HRRM TT,(C)
007 071 024 MOVE R,B
008 155 029 JRST ELSB1
009
010 035 006 IAP2: JUMPL C,IAP2A
011 035 006 HRRZ A,(C) ;APPLY FUNCTIONAL FROM VALUE CELL
012 HLRZ A,(A)
013 HRRZ A,@(A)
014 CAIE A,QUNBOUND ;FOOBAR! IT'S UNBOUND
015 161 037 JRST ILP1B
016 209 011 JRST IAP2A
FUNCTION, QUOTE, DECLARE, COMMENT, SETQ, AND, OR LISP.393[MAC,LSP] 01/17/78 Page 164
001
002 IAPLMB: HLRZ TT,(B) ;APPLY A LAMBDA EXPRESSION
003 181 046 MOVEI D,(TT)
004 005 042 LSH D,-SEGLOG
005 036 033 MOVE D,ST(D)
006 181 046 TLNE D,SY
007 164 070 JUMPN TT,IAP3
008 131 052 SETZ D, ;IMPORTANT THAT D BE NON-NEG - SEE IAP4
009 035 006 MOVEI C,(TT)
010 HRRZ B,(B)
011 071 024 MOVE R,T
012 164 031 IPLMB1: JUMPE T,IPLMB2 ;NO MORE ARGS
013 JUMPE TT,QF2A ;TOO MANY ARGS SUPPLIED
014 IAP5: HLRZ A,(TT)
015 SKIPE V.RSET
016 164 024 JRST IAP5B
017 IAP5C: MOVEI AR1,1(T)
018 ADD AR1,P
019 181 046 HLLZ D,(AR1) ;SEE COMMENT AT EFX - ALLOWS
020 HRLM A,(AR1) ; A FEXPR TO TAKE AN A-LIST ARG
021 HRRZ TT,(TT)
022 164 012 AOJA T,IPLMB1
023
024 181 046 IAP5B: MOVEI D,(A)
025 005 042 LSH D,-SEGLOG
026 036 033 MOVE D,ST(D)
027 181 046 TLNN D,SY
028 209 011 JRST LMBERR
029 164 017 JRST IAP5C
030
031 164 097 IPLMB2: JUMPN TT,IAP4 ;TOO FEW ARGS SUPPLIED
032 164 042 JUMPN R,IPLMB4 ;NO LAMBDA LIST IN FUN
033 POP P,TT
034 059 031 HRRI TT,CPOPJ ;LAMBDA LIST IS NULL
035 SKIPE V.RSET
036 PUSH P,TT
037 HRRZ A,(B)
038 164 058 JUMPN A,LMBLP
039 HLRZ A,(B)
040 152 043 JRST EVAL
041
042 014 066 IPLMB4: MOVEM SP,SPSV
043 SKIPA
044 050 010 IPLM4A: PUSHJ P,BIND ;BIND VALUES TO LAMBDA VARS
045 POP P,AR1 ;FUN HAS A NON-NL LAMBDA LIST
046 HLRZ A,AR1
047 164 044 AOJLE R,IPLM4A
048 SKIPN V.RSET
049 164 053 JRST IPLMB5
050 059 031 HRRI AR1,CPOPJ
051 TLNE AR1,-1
052 PUSH P,AR1
053 014 016 IPLMB5: JSP T,SPECX
FUNCTION, QUOTE, DECLARE, COMMENT, SETQ, AND, OR LISP.393[MAC,LSP] 01/17/78 Page 164.1
054 HRRZ AR1,(B)
055 164 094 PUSH P,CUNBIND
056 HLRZ A,(B)
057 152 043 JUMPE AR1,EVAL ;A GENERALIZED LAMBDA, WITH NON-NULL LAMBDA LIST
058 LMBLP: PUSH P,B ;FOR GENERALIZED LAMBDAS, EVALUATES A SEQUENCE OF EXP'S
059 HLRZ A,(B)
060 152 043 PUSHJ P,EVAL
061 LMBLP1: POP P,B
062 HRRZ B,(B)
063 164 058 LMBLP2: JUMPN B,LMBLP
064 POPJ P,
065
066 IPROGN: MOVEI A,NIL ;INTERNAL PROGN
067 164 063 JRST LMBLP2
068
069
070 IAP3: MOVEI A,(TT) ;APPLY LEXPR
071 MOVN TT,T
072 CAIL TT,XHINUM
073 209 011 JRST LXPRLZ
074 059 031 MOVEI AR1,CPOPJ
075 035 006 HRRM AR1,(C)
076 MOVEI AR1,IN0(TT)
077 014 066 MOVEM SP,SPSV
078 050 010 PUSHJ P,BIND
079 035 006 MOVEI C,(C)
080 035 006 EXCH C,ARGLOC
081 035 006 HRLI C,ARGLOC
082 035 006 PUSH SP,C ;BIND ARGLOC TO LOC OF ARGS ON PDL
083 EXCH AR1,ARGNUM
084 HRLI AR1,ARGNUM
085 PUSH SP,AR1 ;BIND ARGNUM TO NUMBER OF ARGS
086 014 016 JSP T,SPECX
087 HRRZ B,(B)
088 164 058 PUSHJ P,LMBLP
089 SKIPN T,@ARGNUM
090 049 033 JRST UNBIND
091 HRLS T
092 SUB P,T
093 049 033 JRST UNBIND
094 049 033 CUNBIN: JRST UNBIND
095
096
097 181 046 IAP4: JUMPGE D,QF3A
098 071 024 AOJN R,QF3A
099 209 011 IFE FUNAFL, JRST QF2A
100 137 004 IFN FUNAFL, JRST IAP4A ;FEXPR OF TWO ARGS
101
102 SUBTTL FUNCTION, QUOTE, DECLARE, COMMENT, SETQ, AND, OR
103
FUNCTION, QUOTE, DECLARE, COMMENT, SETQ, AND, OR LISP.393[MAC,LSP] 01/17/78 Page 165
001
002 166 074 FUNCTION: SKIPA D,CQFUNCTION ;FEXPR 1
003 181 046 QUOTE: MOVEI D,QQUOTE ;FEXPR 1
004 JUMPE A,WNAFOSE
005 HRRZ TT,(A)
006 108 031 JUMPE TT,$CAR
007 209 011 JRST WNAFOSE
008
009 DECLARE: MOVEI A,QDECLARE ;FSUBR (IGNORES ARG)
010 POPJ P,
011
012 $COMMENT: MOVEI A,Q$COMMENT ;FSUBR (IGNORES ARG)
013 POPJ P,
014
015
016 SETQ: PUSH P,A
017 SET1: HLRZ A,@(P)
018 102 048 JSP D,SETCK
019 HRRZ B,@(P)
020 JUMPE B,SETWNA
021 PUSH P,A ;ATOM TO BE SETQD
022 HLRZ A,(B)
023 HRRZ B,(B)
024 MOVEM B,-1(P)
025 152 043 PUSHJ P,EVAL
026 POP P,AR1
027 057 006 JSP T,.SET
028 SKIPE (P)
029 165 017 JRST SET1
030 059 040 JRST POP1J
031
032
033 $AND: HRLI A,TRUTH
034 035 006 $OR: HLRZ C,A
035 035 006 PUSH P,C
036 035 006 ANDOR: HRRZ C,A
037 059 035 JUMPE C,POPAJ
038 035 006 MOVSI C,(SKIPE (P))
039 TLNE A,-1
040 035 006 MOVSI C,(SKIPN (P))
041 209 025 XCT C
042 059 035 JRST POPAJ
043 MOVEM A,(P)
044 HLRZ A,(A)
045 152 043 PUSHJ P,EVAL
046 EXCH A,(P)
047 HRR A,(A)
048 165 036 JRST ANDOR
PROG, PROGV, RETURN, GO LISP.393[MAC,LSP] 01/17/78 Page 166
001
002 SUBTTL PROG, PROGV, RETURN, GO
003
004 PROG: HLRZ AR2A,(A) ;FSUBR
005 HRRZ A,(A)
006 PUSH P,A
007 131 052 SETZ C,
008 166 038 JSP T,PBIND ;BIND PROG VARIABLES TO NIL
009 POP P,A
010 166 014 PUSHJ P,PG0 ;EVALUATE PROG BODY
011 MOVEI A,NIL
012 049 033 JRST UNBIND ;UNBIND VARIABLES
013
014 PG0: PUSH P,PA3
015 020 031 PUSH P,PA4
016 PUSH P,SP
017 PUSH P,FXP
018 PUSH P,FLP
019 166 014 LPRP==.-PG0+1 ;LENGTH OF PROG PDL, IE HOW MUCH PROG HAS
020 020 031 MOVEM P,PA4 ;CAUSED TO BE PUSHED
021 HRLS A
022 MOVEM A,PA3
023 PG1: HLRZ T,PA3
024 166 067 PG1A: JUMPE T,PRXIT ;NORMAL EXIT
025 HLRZ A,(T)
026 HRRZ T,(T)
027 HRLM T,PA3
028 SKOTT A,LS
029 166 023 JRST PG1
030 152 043 PUSHJ P,EVAL
031 166 023 PG0A: JRST PG1
032
033 ;;; JSP T,VBIND ;LIST OF SYMBOLS IN AR2A, VALUES IN A
034 ;;; BINDS EACH SPECIAL VARIABLE IN THE LIST TO CORRESPODNING VALUES.
035 ;;; IF VALUES LIST TOO SHORT, NIL GETS USED (OBVIOUSLY).
036
037 035 006 VBIND: MOVEI C,(A) ;INTERPRETED AND COMPILED PROGV COME HERE
038 014 066 PBIND: MOVEM SP,SPSV ;BIND PROG VARIABLES
039 014 016 JUMPE AR2A,SPECX
040 MOVEI AR1,NIL
041 PBIND1: HLRZ A,(AR2A) ;NEXT VARIABLE
042 035 006 HLRZ AR1,(C) ;NEXT VALUE
043 050 010 PUSHJ P,BIND ;BIND!
044 035 006 HRRZ C,(C)
045 HRRZ AR2A,(AR2A)
046 166 041 JUMPN AR2A,PBIND1
047 014 016 JRST SPECX
048
049 PROGV: HRRZ B,(A) ;FSUBR
050 035 006 HRRZ C,(B)
051 HLRZ A,(A)
052 HLRZ B,(B)
053 035 006 PUSH P,C
PROG, PROGV, RETURN, GO LISP.393[MAC,LSP] 01/17/78 Page 166.1
054 PUSH P,B
055 152 043 PUSHJ P,EVAL ;GET LIST OF VARIABLES
056 EXCH A,(P)
057 152 043 PUSHJ P,EVAL ;GET LIST OF VALUES
058 POP P,AR2A
059 166 037 JSP T,VBIND ;BIND VARIABLES
060 POP P,B
061 164 058 PUSHJ P,LMBLP ;EVAL REST LIKE LAMBDA BODY
062 049 033 JRST UNBIND
063
064 171 024 RETURN: JSP T,BKERST ;SUBR 1
065 020 031 MOVE P,PA4
066 166 019 AOS -LPRP+1(P) ;RETURN CAUSES SKIP
067 PRXIT: POP P,FLP ;PROG EXIT
068 POP P,FXP
069 POP P,TT
070 049 003 PUSHJ P,UBD0
071 020 031 POP P,PA4
072 ERRP4: POP P,PA3
073 RHAPJ: MOVEI A,(A)
074 CQFUNCTION: POPJ P,QFUNCTION
PROG, PROGV, RETURN, GO LISP.393[MAC,LSP] 01/17/78 Page 167
001
002 057 021 GO: JSP TT,FWNACK
003 FA1,,QGO
004 HLRZ A,(A)
005 080 013 GO2: JSP T,SPATOM ;LEAVES TYPE BITS IN TT
006 167 031 JRST GO3
007 171 024 GO1: JSP T,BKERST
008 HRRZ T,PA3
009 PG5: JUMPE T,EG1
010 HLRZ TT,(T)
011 HRRZ T,(T)
012 CAIN TT,(A)
013 167 024 JRST PG5A
014 TLNN A,400000 ;4.9 BIT => GO TAG IS NUMERIC
015 167 009 JRST PG5
016 181 046 MOVEI D,(TT)
017 005 042 LSH D,-SEGLOG
018 036 033 SKIPL D,ST(D)
019 181 046 TLNN D,FX+FL
020 167 009 JRST PG5
021 MOVE TT,(TT)
022 CAME TT,(A)
023 167 009 JRST PG5
024 020 031 PG5A: MOVE P,PA4
025 MOVE FLP,(P)
026 MOVE FXP,-1(P)
027 HRRZ TT,-2(P)
028 049 005 PUSHJ P,UBD
029 166 024 JRST PG1A
030
031 GO3: TLNN TT,FX+FL
032 167 039 JRST GO3A
033 GO3B: MOVE TT,(A) ;SET 4.9 BIT OF A IF TAG IS NUMERIC
034 CAML TT,[-XLONUM]
035 CAIL TT,XHINUM ; BUT NOT INUM
036 TLO A,400000
037 167 007 JRST GO1
038
039 152 043 GO3A: PUSHJ P,EVAL ;IF ARG TO GO ISN'T ATOMIC, DO ONE EVAL AND TRY AGAIN
040 MOVEI TT,(A)
041 005 042 LSH TT,-SEGLOG
042 036 033 MOVE TT,ST(TT)
043 TLNE TT,FX+FL
044 167 033 JRST GO3B
045 TLNE TT,SY
046 167 007 JRST GO1
047 209 011 JRST EG1
DO FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 168
001
002 SUBTTL DO FUNCTION
003
004 020 031 DO: PUSH P,PA4
005 020 031 SETZM PA4
006 064 009 PUSH FXP,R70 ;A "DO SWITCH" TO MARK EXPANDED FORMAT
007 PUSH P,A
008 HLRZ A,(A)
009 SKOTT A,LS ;HUNKS WIN AS WELL AS LISTS
010 168 017 JUMPN A,DO4A
011 HRROM A,(FXP)
012 HLRZ A,@(P) ;SETUP FOR MULTIPLE INDICES
013 035 006 HRRZ C,@(P)
014 035 006 HLRZ B,(C)
015 168 022 JRST DO4
016
017 DO4A: MOVE A,(P) ;SINGLE INDEX DO
018 HRRZ B,(A)
019 HRRZ B,(B)
020 HRRZ B,(B)
021 035 006 MOVE C,B
022 035 006 DO4: HRRZ C,(C)
023 MOVEM A,(P) ; (P) PROG BODY
024 DO4C: SKOTT B,LS
025 JUMPN B,DOERRE
026 PUSH P,B ; -1(P) ENDTEST
027 035 006 PUSH P,C ; -2(P) DO VARS LIST
028 MOVE A,-2(P)
029 071 024 MOVSI R,600000 ;EVALUATE AND SETUP INITIAL VALUES
030 SKIPN -1(P)
031 071 024 MOVSI R,400000 ;200000 BIT SAYS STEPPERS ARE OKAY
032 169 018 PUSHJ FXP,DO5
033 SKIPN -1(P)
034 169 013 JRST DO4D
035 DO7: HLRZ A,@-1(P)
036 152 043 PUSHJ P,EVAL
037 169 002 JUMPN A,DO8
038 DO7A: MOVE A,(P)
039 166 014 PUSHJ P,PG0 ;DO PROG BODY (MAY SKIP ON RETURN STATEMENT)
040 169 008 JRST DO2
041 DO9: MOVE B,-2(P)
042 064 009 SUB P,R70+3 ;BREAK OUT OF BODY BY RETURN STATEMENT
043 020 031 POP P,PA4
044 064 009 SUB FXP,R70+1
045 049 033 JUMPN B,UNBIND
046 POPJ P,
DO FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 169
001
002 DO8: SKIPN A,(FXP)
003 168 041 JRST DO9 ;SIMPLE DO FORMAT
004 HRRZ B,@-1(P) ;DO PASSED ENDTEST, AND RETURNS A VALUE
005 164 066 PUSHJ P,IPROGN
006 168 041 JRST DO9
007
008 DO2: MOVE A,-2(P)
009 071 024 MOVEI R,0 ;DO STEPPING FUNCTIONS
010 169 018 PUSHJ FXP,DO5
011 168 035 JRST DO7
012
013 DO4D: MOVE A,(P)
014 166 014 PUSHJ P,PG0
015 131 052 SETZ A, ;DEFAULT VALUE OF ONCE-THROUGH DO IS NIL
016 168 041 JRST DO9
017
018 170 014 DO5: JUMPE A,DO6 ;DOES PARALLEL SETQS - ON LISTS LIKE (I V1 V2)
019 PUSH P,A ;WILL DO (SETQ I V1) IF R < 0
020 SKIPE -1(FXP) ;WILL DO (SETQ I V2) IF R > 0
021 HLRZ A,(A) ;IF DOSW INDICATES SINGLE INDEX, THEN ONLY ONE LIST
022 DO5Q: MOVEI B,(A)
023 169 035 JUMPGE R,DO5F
024 SKOTT A,LS
025 209 011 JRST DOERR
026 HLRZ A,(B)
027 080 013 JSP T,SPATOM
028 209 011 JRST DOERR
029 071 024 TLNE R,200000
030 169 035 JRST DO5F
031 HRRZ A,(B)
032 169 035 JUMPE A,DO5F
033 HRRZ A,(A)
034 JUMPN A,DO5ER
035 DO5F: HLRZ A,(B)
036 HRLM A,(P)
037 HRRZ A,(B)
038 170 002 JUMPL R,DO5E
039 169 042 JUMPE A,DO5B
040 HRRZ A,(A)
041 170 003 JUMPN A,DO5D
042 DO5B: POP P,A
043 170 009 SOJA R,DO5C
DO FUNCTION LISP.393[MAC,LSP] 01/17/78 Page 170
001
002 170 007 DO5E: JUMPE A,DO5G ;(I) IS SAME AS (I NIL) ON INITIAL VALUE
003 DO5D: HLRZ A,(A)
004 071 024 PUSH FXP,R
005 152 043 PUSHJ P,EVAL
006 071 024 POP FXP,R
007 DO5G: HLL A,(P)
008 EXCH A,(P) ;NOW (P) HAS ATOM,,VALUE
009 DO5C: HRRZ A,(A)
010 SKIPN -1(FXP)
011 MOVEI A,0 ;SO THAT SINGLE FORMAT DO WILL DROP OUT
012 169 018 AOJA R,DO5
013
014 071 024 DO6: TRNN R,-1 ;[(SETQ I V1) FROM ABOVE]
015 POPJ FXP, ;FIRST TIME THROUGH, WE ALLOW OLD BINDINGS
016 170 026 JUMPGE R,DO6C ;TO BE REMEMBERED ON THE SPDL FOR LATER UNBINDING
017 071 024 HRRZS R
018 014 066 MOVEM SP,SPSV
019 DO6A: POP P,AR1
020 HLRZ A,AR1
021 050 010 PUSHJ P,BIND
022 170 019 SOJG R,DO6A
023 014 016 JSP T,SPECX
024 POPJ FXP,
025
026 DO6C: POP P,AR1 ;DURING THE STEPPING PHASE, AS OPPOSED TO
027 HLRZ A,AR1 ;THE INITIALIZATION PHASE, WE LET NO BINDINGS
028 050 010 PUSHJ P,BIND ;ACCUMULATE ON THE SPDL
029 014 013 JSP T,SETXIT
030 170 026 SOJG R,DO6C
031 POPJ FXP,
COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 171
001
002 SUBTTL COND, ERRSET, ERR, CATCH, THROW, CASE, IF
003
004 COND1: HRRZ A,(T)
005 059 031 COND: JUMPE A,CPOPJ ;ENTRY
006 PUSH P,A
007 HLRZ A,(A)
008 HLRZ A,(A)
009 CAIE A,TRUTH
010 152 043 PUSHJ P,EVAL
011 CON3: POP P,T
012 171 004 JUMPE A,COND1 ;IF FIRST OF COND PAIR IS TRUE
013 HLRZ T,(T)
014 SKIPA
015 COND2: POP P,T
016 HRRZ T,(T)
017 059 031 JUMPE T,CPOPJ ;LOOP FOR GENERALIZED COND PAIR
018 PUSH P,T
019 HLRZ A,(T)
020 152 043 PUSHJ P,EVAL
021 171 015 CON2: JRST COND2
022
023
024 020 031 BKERST: SKIPN TT,PA4
025 171 041 JRST BKRST1
026 TLZ TT,-1
027 020 029 SKIPE B,CATRTN
028 171 037 JRST BKRST2
029 020 028 BKRST3: SKIPE B,ERRTN
030 CAILE TT,(B)
031 209 011 JRST (T) ;NO TROUBLESOME CATCHS OR ERRSETS
032 171 024 BKRST4: MOVEI TT,BKERST
033 057 043 BKRST0: MOVEM TT,-LERSTP(B) ;BREAK UP A TROUBLESOME CATCH OR ERRSET, E.G.
034 MOVE P,B ;(PROG (A) (ERRSET (RETURN (FOO A))))
035 057 053 JRST ERR1 ;AND THEN TRY BKERST AGAIN
036
037 BKRST2: CAILE TT,(B)
038 171 029 JRST BKRST3 ;CATCH ISN'T TROUBLESOME, SO TEST FOR ERRSETS
039 171 032 JRST BKRST4 ;AH, CATCH IS TROUBLESOME!
040
041 BKRST1: MOVEI A,LGOR
042 %FAC EMS22
COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 172
001
002 057 021 ERRSET: JSP TT,FWNACK
003 FA12,,QERRSET
004 035 006 MOVEI C,TRUTH
005 HRRZ B,(A)
006 172 012 JUMPE B,ERRST3
007 PUSH P,A
008 HLRZ A,(B)
009 152 043 PUSHJ P,EVAL
010 035 006 MOVEI C,(A)
011 POP P,A
012 057 038 ERRST3: JSP T,ERSTP
013 020 028 MOVEM P,ERRTN
014 020 033 MOVEM C,ERRSW
015 HLRZ A,(A)
016 152 043 PUSHJ P,EVAL
017 073 008 ERRNX: PUSHJ P,NCONS ;NORMAL EXIT
018 057 046 JRST ERUN0
019
020 057 021 ERR: JSP TT,FWNACK
021 FA012,,QERR
022 JUMPE A,ERR2
023 HRRZ B,(A)
024 JUMPE B,.+3
025 HLRZ B,(B)
026 172 031 JUMPE B,ERR3A
027 HLRZ A,(A) ;EVAL BEFORE UNBLOCKING
028 152 043 PUSHJ P,EVAL
029 209 011 JRST ERR2
030
031 020 028 ERR3A: SKIPN ERRTN
032 040 025 JRST LSPRET
033 172 036 MOVEI T,ERR3
034 057 043 EXCH T,-LERSTP(P)
035 054 033 JRST ERR0 ;UNBLOCK THE ERRSET, THEN
036 ERR3: SKIPE A ;EVAL THE ARG TO ERR
037 HLRZ A,(A)
038 PUSH P,T
039 152 043 JRST EVAL
040
041
042 057 021 CATCH: JSP TT,FWNACK
043 FA12,,QCATCH
044 172 060 PUSHJ P,CATHRO
045 054 005 JSP TT,CATPS1
046 HLRZ A,(B)
047 152 043 PUSHJ P,EVAL
048 MOVEI B,NIL ;CAUSE MOST RECENT CATCH TO BE THROWN
049 054 014 JRST THROW1
050
051 057 021 THROW: JSP TT,FWNACK
052 FA12,,QTHROW
053 172 060 PUSHJ P,CATHRO
COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 172.1
054 PUSH P,A
055 HLRZ A,(B)
056 152 043 PUSHJ P,EVAL
057 POP P,B
058 054 014 JRST THROW1
059
060 CATHRO: MOVE B,A
061 HRRZ A,(A)
062 059 031 JUMPE A,CPOPJ
063 HLRZ A,(A)
064 POPJ P,
COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 173
001
002 071 024 CASEQ: TDZA R,R ;FLAG IN R WHETHER CASE/Q
003 071 024 CASE: SETOI R,
004 059 031 JUMPE A,CPOPJ ;ENTRY, RETURN NIL IF NO ARGS
005 PUSH P,A ;SAVE POINTER TO ARG LIST
006 HLRZ A,(A) ;GET EXPRESSION TO MATCH AGAINST
007 071 024 CASEE: PUSH FXP,R
008 CAIE A,TRUTH ;FOR SPEED, CHECK FOR SPECIAL KIND
009 152 043 PUSHJ P,EVAL
010 071 024 POP FXP,R
011 MOVE T,A
012 005 042 LSH T,-SEGLOG
013 036 033 MOVE T,ST(T)
014 TLNE T,FX ;FIXNUM EXPRESSION?
015 173 021 JRST CASEF
016 TLNE T,SY ;SYMBOL AS EXPRESSION?
017 173 024 JRST CASES
018 086 009 WTA [MATCHING EXPRESSION NOT FIXNUM OR SYMBOL!]
019 173 007 JRST CASEE ;WIN IF USER TRIES AGAIN
020
021 CASEF: MOVSI T,FX ;TEST AGAINST FIXNUMS ONLY
022 173 025 JRST CASE1
023
024 CASES: MOVSI T,SY ;TEST AGAINST SYMBOLS ONLY
025 CASE1: POP P,B ;POINTER TO CASE'S ARGUMENTS
026 PUSH P,A ;EQ TEST AGAINST SYMBOL RETURNED
027 HRRZ A,(B) ;THE LIST OF MATCHING SETS AND EXPRS
028 CASE1E: PUSH P,A
029 HLRZ A,(A) ;THE POINTER TO THE NEXT SET/EXPRS PAIR
030 HLRZ A,(A) ;THE LIST OF MATCHES OR THE SINGLE MATCH
031 CASE1H: CAIN A,TRUTH ;IF T THEN AN 'OTHERWISE' CLAUSE
032 173 074 JRST CASEM
033 MOVEI TT,(A)
034 005 042 LSH TT,-SEGLOG
035 036 033 MOVE TT,ST(TT)
036 TLNN TT,LS ;IS THE MATCHING SET A LIST?
037 173 062 JRST CASE1Q ;NO, HANDLE SPECIALLY
038 CASE1D: PUSH P,A
039 HLRZ A,(A) ;GET NEXT ELEMENT
040 173 047 CASE1B: JUMPE R,CASE1A ;DON'T EVALUATE EXPR IF CASEQ
041 CAIN A,TRUTH
042 173 047 JRST CASE1A
043 PUSH P,T ;SAVE FLAGS OVER EVAL
044 152 043 PUSHJ P,EVAL
045 POP P,T
046 071 024 SETOI R, ;MAKE SURE FLAG IS STILL CORRECT
047 CASE1A: MOVEI TT,(A)
048 005 042 LSH TT,-SEGLOG
049 036 033 TDNN T,ST(TT) ;MATCHING TYPE?
050 173 083 JRST CASE1C
051 POP P,B
052 CAMN A,-1(P) ;USE EQ TEST
053 173 074 JRST CASEM ;MATCH FOUND, PROCESS EXPRESSIONS
COND, ERRSET, ERR, CATCH, THROW, CASE, IF LISP.393[MAC,LSP] 01/17/78 Page 173.1
054 HRRZ A,(B) ;GET THE CDR
055 173 038 JUMPN A,CASE1D ;IF MORE MATCHING IN THIS LIST THEN PROCEED
056 CASE1G: POP P,A ;RESTORE THE LIST OF PAIRS POINTER
057 HRRZ A,(A) ;THE CDR POINTS TO NEXT CONS
058 173 028 JUMPN A,CASE1E ;IF NOT END OF LIST THEN PROCEED
059 POPI P,1 ;GET RID OF MATCHING POINTER
060 POPJ P,
061
062 173 068 CASE1Q: JUMPE R,CASEBQ ;IF CASEQ LEAVE UNEVALUATED
063 PUSH P,T ;SAVE FLAG
064 CAIE A,TRUTH
065 152 043 PUSHJ P,EVAL
066 POP P,T
067 071 024 SETO R, ;FLAG MUST BE SET IF DID EVAL
068 CASEBQ: MOVEI TT,(A) ;TYPE CHECK UNEVALUATED MATCHING ARG
069 005 042 LSH TT,-SEGLOG
070 036 033 TDNN T,ST(TT)
071 173 080 JRST CASEAQ ;NOT MATCH
072 CAME A,-1(P) ;USE EQ TEST
073 173 056 JRST CASE1G ;MATCH NOT FOUND
074 CASEM: POP P,A ;GET BACK POINTER TO CONS WITH MATCH
075 HLRZ A,(A)
076 MOVEM A,(P) ;CLOBBER MATCHING ARG WITH EXPR LIST
077 131 052 SETZ A, ;MAKE SURE RETURN NIL IF NOTHING TO DO
078 171 015 JRST COND2
079
080 086 009 CASEAQ: WTA [DOES NOT MATCH MATCHING EXPRESSION TYPE!]
081 173 031 JRST CASE1H
082
083 CASE1C: POP P,A
084 086 009 WTA [DOES NOT MATCH MATCHING EXPRESSION TYPE!]
085 173 038 JRST CASE1D
086
087 IF: PUSH P,A
088 HLRZ A,(A) ;TEST EXPRESSION
089 CAIE A,TRUTH
090 152 043 PUSHJ P,EVAL
091 POP P,B
092 HRRZ B,(B)
093 SKIPN A
094 HRRZ B,(B)
095 HLRZ A,(B)
096 CAIE A,TRUTH
097 152 043 PUSHJ P,EVAL
098 POPJ P,
STORE, BREAK, SIGNP LISP.393[MAC,LSP] 01/17/78 Page 174
001
002 SUBTTL STORE, BREAK, SIGNP
003
004 057 021 STORE: JSP TT,FWNACK
005 FA2,,QSTORE
006 HLRZ B,(A)
007 PUSH P,B
008 HRRZ A,(A)
009 HLRZ A,(A)
010 152 043 PUSHJ P,EVAL ;EVALUATE SECOND ARGUMENT FIRST!
011 PUSH P,A
012 STORE7: HRRZ A,-1(P)
013 SETZM LISAR
014 152 026 PUSHJ P,EVNH0 ;EVALUATE ARRAY REFERENCE WITHOUT HOOKING IT
015 SKIPN A,LISAR ;ALWAYS CHECK FOR THIS GROSS LOSS
016 209 011 JRST STORE5
017 SKIPN V.RSET
018 174 023 JRST STORE9
019 JSP T,ARYSIZ ;GET SIZE OF ARRAY IN WORDS IN TT
020 071 024 TLNN R,200000 ;=> NEGATIVE INDEX
021 071 024 CAIG TT,(R) ;THERE'S PROBABLY A FENCE-POST FOR SX ARRAYS HERE
022 209 011 JRST STORE5
023 STORE9: POP P,A
024 064 009 SUB P,R70+1
025 056 009 JSP T,.STORE
026 SETZM LISAR
027 POPJ P,
028
029
030 057 021 BREAK: JSP TT,FWNACK ;FSUBR (1 . 2)
031 FA12,,QBREAK
032 HLRZ B,(A) ;BKPT NAME
033 HRRZ A,(A)
034 103 005 JUMPE A,$BRK0 ;NO SECOND ARG => ALWAYS BREAK
035 HLRZ A,(A) ;TO-BREAK-OR-NOT SWITCH
036 PUSH P,B
037 152 043 PUSHJ P,EVAL ;THIS IS A CROCK!!!
038 POP P,B
039 103 004 JRST $BREAK ;A = BREAKP, B = BREAKID
040
041
042 057 021 SIGNP: JSP TT,FWNACK ;FSUBR 2
043 FA2,,QSIGNP
044 PUSH P,(A)
045 HLRZ A,(A)
046 PUSH P,A
047 082 048 SIGNP0: PUSHJ P,PNGET
048 HLRZ A,(A)
049 MOVS T,(A)
050 HRRZ A,(A)
051 JUMPN A,SIGNPE
052 MOVNI A,6
053 174 068 CAIE T,@SPTB+6(A)
STORE, BREAK, SIGNP LISP.393[MAC,LSP] 01/17/78 Page 174.1
054 AOJL A,.-1
055 JUMPGE A,SIGNPE
056 174 068 HLLZ A,SPTB+6(A)
057 064 009 SUB P,R70+1
058 EXCH A,(P)
059 HLRZ A,(A)
060 152 043 PUSHJ P,EVAL
061 PUSHJ P,NUMBERP
062 059 040 JUMPE A,POP1J
063 POP P,T
064 086 011 HRRI T,TRUE
065 209 025 XCT T
066 081 044 JRST FALSE
067
068 SPTB:
069 220 022 IRP Q,,[L,E,LE,G,GE,N]
070 JUMP!Q TT,(ASCII \Q\)
071 TERMIN
PROG2, PROGN, EQ, RPLACA, RPLACD LISP.393[MAC,LSP] 01/17/78 Page 175
001
002 SUBTTL PROG2, PROGN, EQ, RPLACA, RPLACD
003
004 181 046 PROG2: MOVEI D,QPROG2
005 064 014 CAMLE T,XC-2
006 209 011 JRST WNALOSE
007 HRLI T,-1(T)
008 ADD T,P
009 MOVE A,2(T)
010 MOVEM T,P
011 POPJ P,
012
013 081 044 PROGN: AOJG T,FALSE
014 POP P,A
015 059 031 PROGN1: JUMPE T,CPOPJ
016 HRLI T,-1(T)
017 ADD P,T
018 POPJ P,
019
020 EQ: CAMN A,B ;SUBR 2 - POINTER IDENTITY PREDICATE
021 086 011 JRST TRUE
022 081 044 JRST FALSE
023
024 RPLACA: SKOTT A,LS
025 209 011 JRST RPLCA0
026 TLNE TT,PUR+VC
027 209 011 JRST RPLCA1
028 HRLM B,(A)
029 POPJ P,
030
031 RPLACD: ;SUBR 2 - CLOBBER CDR OF FIRST ARG WITH SECOND
032 SKOTT A,LS
033 175 039 JRST RPLCD2
034 TLNE TT,PUR
035 209 011 JRST RPLCD1
036 RPLCD3: HRRM B,(A)
037 POPJ P,
038
039 RPLCD2: JUMPE A,RPLCD0 ;(RPLACD NIL FOO) IS ALWAYS A LOSS
040 SKIPE T,VCDR
041 CAIN T,QLIST ;IF CDR = NIL OR LIST, THEN BOMBOUT
042 209 011 JRST RPLCD0 ;SINCE ARG IS NOT LIST OR NIL
043 CAIN T,QSYMBOL
044 TLNE TT,SY
045 175 036 JRST RPLCD3 ;IF NOT CDR = SYMBOL, THEN ANYTHING GOES
046 209 011 JRST RPLCD0
047
048 158 004 PGTOP EVL,[EVAL, APPLY, STUFF OPEN-CODED BY COMPLR]
PROG2, PROGN, EQ, RPLACA, RPLACD LISP.393[MAC,LSP] 01/17/78 Page 176
001
002
003
004 006 006 $INSRT GCBIB ;GARBAGE COLLECTOR AND ALLOCATION STUFF
005
006
007 006 006 $INSRT READER ;READ AND RELATED FUNCTIONS
008
009
010 006 006 $INSRT ARRAY ;ARRAY PACKAGE
011
012 006 006 $INSRT FASLOA ;FASLOAD
013
014 002 048 IFN QIO,[
015 002 048 $INSRT QIO ;NEW MULTIPLE FILE I/O FUNCTIONS
016 ] ;END OF IFN QIO
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 177
001
002 SUBTTL INTERRUPT HANDLERS
003
004 020 015 PGBOT INT
005
006
007
008 002 048 IFE QIO,[
009
010 002 026 IFN ITS,[
011 ;;; ***** MOBY INTERRUPT ROUTINES *****
012
013 064 014 PINBL: .SPICLR,,XC-1 ;SUSET WORD TO ENABLE INTERRUPTS
014 064 009 PIHOLD: .SPICLR,,R70 ;SUSET WORD TO GAG INTERRUPTS
015
016 020 015 INT0: EXCH A,INT ;BIG DISPATCH !!!
017 177 035 JUMPL A,INT4
018 009 045 TRZE A,IB.TTY ;1
019 177 044 JRST TTYINT
020 009 017 INT1: TLNN A,(IB.TIMR) ;100000,,0
021 009 016 TLNE A,(IB.ALARM) ;200000,,0
022 178 005 JRST TIMOUT
023 009 029 TRZE A,IB.PDLO ;200000
024 209 011 JRST PDLOV
025 009 037 TRZE A,IB.IOC ;400
026 209 011 JRST IOERR
027 009 040 INT2: TRZE A,IB.ILOP ;I ASSUME THAT THERE WILL NEVER BE ANY
028 209 011 JRST ERRILO ;TWO OF THESE INTERRUPTS TOGETHER -
029 009 020 TLZE A,(IB.PUR) ; ILGL OPERATION, PURE PAGE TRAP, OR
030 193 008 JRST PURPGI ; ILGL MEM REFERENCE, PARITY ERROR
031 009 032 TRZE A,IB.MPV ;20000
032 177 039 JRST INT3
033 009 018 TLZE A,(IB.PARITY)
034 184 039 JRST PARERR
035 015 065 INT4: SKIPN UPIINT
036 NOINT: .VALUE
037 015 065 JRST @UPIINT
038
039 020 016 INT3: HRRZ A,IPCLOK
040 049 020 CAIN A,UBD1 ;ALLOW SPDL RESTORATION TO TAKE PLACE
041 177 051 JRST INTEX1 ;EVEN IF ONE SLOT IS CLOBBERED
042 209 011 JRST INTILM
043
044 020 018 TTYINT: MOVEM A,INTSV
045 010 009 MOVEI A,TYIC
046 .ITYIC A,
047 177 049 JRST INTEX
048 016 014 JSR CNTROL
049 020 018 INTEX: SKIPE A,INTSV
050 177 020 JRST INT1
051 020 015 INTEX1: MOVE A,INT
052 020 016 .DISMIS IPCLOK
053
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 177.1
054 010 009 CN.Z: .RESET TYIC, ;SO SUPERIOR WON'T SEE ↑Z AS INPUT
055 .VALUE [ASCII \:VK \]
056 016 014 JRST 2,@CNTROL
057
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 178
001
002
003 ;;; IFN ITS
004
005 020 018 TIMOUT: MOVEM A,INTSV
006 SKIPN VALARMCLOCK ;INT FROM FRUSTRATED ALARMCLOCK
007 178 029 JRST TIMO1
008 177 049 MOVEI A,INTEX
009 016 014 MOVEM A,CNTROL ;THIS IS A HACK
010 020 018 MOVE A,INTSV
011 009 016 TLZN A,(IB.ALARM)
012 178 024 JRST TIMO6
013 020 018 MOVEM A,INTSV
014 MOVSI A,400000 ;REAL TIME INT, SO SHUT OFF CLOCK
015 .REALT A,
016 SKIPA A,[QTIME,,3]
017 TIMO3: MOVE A,[Q$RUNTIME,,3]
018 015 026 SKIPL UNREAL ;MAYBE CLOCK INTS AREN'T PERMITTED NOW
019 204 013 JRST UINT1
020 MOVSS A ;IF SO, QUEUE IT UP
021 028 021 MOVSM A,UNRRUN-Q$RUNTIME(A)
022 177 049 JRST INTEX
023
024 009 017 TIMO6: TLZN A,(IB.TIMR)
025 177 049 JRST INTEX ;????
026 020 018 MOVEM A,INTSV
027 178 017 JRST TIMO3
028
029 009 016 TIMO1: TLNN A,(IB.ALARM)
030 178 034 JRST TIMO7
031 MOVSI A,400000
032 .REALT A,
033 020 018 MOVE A,INTSV
034 009 016 TIMO7: TLZ A,(IB.TIMR+IB.ALARM) ;NO ALARM FNCTION, SO FLUSH INTERRUPTS
035 177 020 JUMPN A,INT1
036 177 051 JRST INTEX1
037
038 ] ;END OF IFN ITS
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 179
001
002 ;;; IFE QIO
003
004 005 005 IFN D10,[
005 ;;; DECSYSTEM-10 INTERRUPT ROUTINES
006
007 INT0: PIOF
008 020 015 MOVEM A,INT ;SAVE REG A
009 MOVE A,.JBCNI"
010 009 029 TRZE A,IB.PDLOV ;PDL OVERFLOW?
011 209 011 JRST PDLOV ;YEP
012 009 032 TRZE A,IB.MPV ;ILL MEM REF?
013 209 011 JRST INTILM
014 006 115 NOINT: HALT ;I DONT KNOW WHAT THIS IS!
015
016 030 024 TTYINT: AOSLE UPCOK
017 209 011 JRST 2,@.JBOPC"
018 020 015 MOVEM A,INT
019 MOVE A,.JBOPC"
020 020 016 MOVEM A,IPCLOK
021 TTYIN0:
022 SA% OUTSTR [ASCIZ \ππ?↑\]
023 002 029 IFN SAIL,[
024 SETO A,
025 CALLI A,400111
026 OUTSTR [ASCIZ \?↑\] ;FOO ON SAIL CHARACTER SET
027 ] ;END OF IFN SAIL
028 INCHRW A
029 ANDI A,37 ;MASK DOWN TO CONTROL CHAR (E.G. C => ↑C)
030 030 024 SETZM UPCOK
031 016 014 JSR CNTROL
032 030 024 SKIPLE UPCOK
033 179 021 JRST TTYIN0
034 020 015 MOVE A,INT
035 030 024 SETOM UPCOK
036 020 016 JRST 2,@IPCLOK
037
038 030 024 UPCHK: SKIPLE UPCOK
039 179 043 JRST UPCHK1
040 030 024 SETOM UPCOK
041 POPJ P,
042
043 030 024 UPCHK1: SETZM UPCOK
044 020 015 MOVEM A,INT
045 020 016 POP P,IPCLOK
046 179 021 JRST TTYIN0
047
048
049
050 CN.Z: SKIPE A,.JBDDT" ;RETURN TO DDT IF IT EXISTS
051 209 011 JRST (A)
052 EXIT 1, ;OTHERWISE CRAP OUT TO MONITOR
053 016 014 ALTP: JRST 2,@CNTROL ;WHEN IN DDT, "ALTP$G" IS GOOD
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 179.1
054
055 ] ;END OF IFN D10
056
057 ] ;END OF IFE QIO
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 180
001
002
003 002 029 IFN SAIL,[
004 030 076 SAILINT:IMSKCL SAINTER ;UNMASK
005 UWAIT ;WAIT FOR UUOS TO FINISH
006 DEBREAK ;INTERRUPT LEVEL BECOMES USER LEVEL
007 030 075 MOVEM TT,ATTSV ;SAVE TT
008 030 079 MOVE TT,SAILJOB+1
009 030 077 MOVEM TT,SAICONT ;CONTINUE ADDRESS IN RIGHT PLACE
010 CLKINT 0 ;DISABLE
011 131 052 SETZ TT,
012 RUNTIME TT, ;WHAT TIME IS IT?
013 030 078 CAMGE TT,SAIALK
014 180 026 JRST SADISMIS ;FOO. NOT LONG ENOUGH
015 SAHACKIT: SKIPN VALARM
016 180 026 JRST SADISMIS
017 030 075 MOVE TT,ATTSV ;PUT BACK TT
018 030 074 MOVEM A,AINT ;DO IT
019 030 073 HRLZ A,ACLKTYP
020 HRRI A,3
021 015 026 SKIPN UNREAL
022 180 030 JRST S2RUN
023 MOVSS A
024 028 021 MOVSM A,UNRRUN-Q$RUNTIME(A)
025 030 074 SADMS0: MOVE A,AINT
026 030 075 SADISMIS: MOVE TT,ATTSV
027 CLKINT 36 ;ENABLE
028 030 076 INTUUO 0,SAINTER ;MASK ON & RETURN
029
030 016 008 S2RUN: JSR INTWAIT
031 209 011 JRST .+2
032 180 025 JRST SADMS0
033 030 074 PUSH P,AINT
034 196 007 PUSHJ P,UINT
035 059 035 JRST POPAJ
036
037 030 076 S2ILIN2:IMSKCL SAINTER
038 UWAIT
039 DEBREAK
040 030 075 MOVEM TT,ATTSV
041 030 079 MOVE TT,SAILJOB+1
042 030 077 MOVEM TT,SAICONT
043 CLKINT 0
044 030 078 SOSLE SAIALK ;TIME YET?
045 209 011 JRST .+2 ;NO
046 180 015 JRST SAHACKIT ;SURE
047 030 075 MOVE TT,ATTSV
048 CLKINT 12
049 030 076 INTUUO 0,SAINTER
050
051 ] ;END OF IFN SAIL
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 181
001
002 002 048 IFN QIO,[
003
004 002 026 IFN ITS,[
005 ;;; NEW-STYLE INTERRUPT TRANSFER VECTOR
006
007 015 046 .SEE IMASK
008 ;;; STANDARD VALUES TO PUT IN .MASK AND .MSK2 USER VARIABLES.
009 ;;; INTERRUPTS NORMALLY ENABLED ARE:
010 ;;; PARITY ERROR
011 ;;; WRITE INTO READ-ONLY MEMORY
012 ;;; MEMORY PROTECTION VIOLATION
013 ;;; ILLEGAL OPERATION
014 ;;; PDL OVERFLOW
015 ;;; I/O CHANNEL ERROR
016 ;;; RUN TIME CLOCK
017 ;;; REAL TIME CLOCK
018 ;;; ALSO, FOR THE USELESS SWITCH:
019 ;;; CLI DEVICE INTERRUPT
020 ;;; SYSTEM GOING DOWN/REVIVED
021 ;;; SYSTEM BEING DEBUGGED
022 ;;; CONTROL OF TTY JUST GIVEN BACK TO LISP
023 ;;; (SSTATUS MAR) MAY ALSO ENABLE THE MAR INTERRUPT
024 .SEE SSMAR
025
026 STDMSK=%PIPAR+%PIWRO+%PIMPV+%PIILO+%PIPDL+%PIIOC+%PIRUN+%PIRLT
027 009 047 IFN USELESS, STDMSK=STDMSK+%PICLI+%PIDWN+%PIDBG+%PIATY
028 009 047 DBGMSK=STDMSK-<%PIPAR+%PIMPV+%PIILO>
029
030 ;;; ALL I/O CHANNELS ARE ENABLED, AND ALL JOB CHANNELS FOR USELESS SWITCH.
031
032 STDMS2==177777
033 002 049 IFN JOBQIO, STDMS2==STDMS2+<377,,>
034 181 032 DBGMS2==STDMS2
035
036
037 DEFINE INTGRP HANDLER+PIRQC=0,IFPIR=0,DF1=STDMSK+%PIMAR-<%PIPDL+%PIPAR+%PIWRO+%PIMPV+%PIILO>,DF2=STDMS2
038 181 049 PIRQC
039 181 055 IFPIR
040 181 049 DF1
041 DF2
042 HANDLER
043 TERMIN
044
045
046 028 050 INTVEC: D←6+3,,INTPDL ;PDL FOR PUSHING INTERRUPT STUFF
047 ;ACS D, R, F ARE SAVED ALONG WITH OTHER CRUD
048
049 184 007 INTGRP MEMERR,PIRQC=%PIPAR+%PIWRO+%PIMPV+%PIILO,DF1=STDMSK+%PIMAR-%PIPDL ;MEMORY
;AND OPCODE ERRORS
050 181 037 INTGRP PDLOV,PIRQC=%PIPDL ;PDL OVERFLOW
051 185 006 INTGRP IOCERR,PIRQC=%PIIOC ;I/O CHANNEL ERROR
052 191 008 IFN USELESS, INTGRP CLIINT,PIRQC=%PICLI ;CLI INTERRUPT
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 181.1
053 191 013 IFN USELESS, INTGRP TTRINT,PIRQC=%PIATY ;TTY RETURNED TO JOB
054 191 018 IFN USELESS, INTGRP SYSINT,PIRQC=%PIDWN+%PIDBG ;SYS DOWN OR BEING DEBUGGED
055 188 010 IFN JOBQIO, INTGRP JOBINT,IFPIR=[377,,] ;INFERIOR PROCEDURES
056 186 009 INTGRP CHNINT,IFPIR=177777 ;I/O CHANNEL INTERRUPTS
057 197 011 TTYDF1==:.-2 .SEE UINT0
058 TTYDF2==:.-1
059 191 023 IFN USELESS, INTGRP MARINT,PIRQC=%PIMAR ;MAR BREAK
060 190 014 INTGRP RUNCLOCK,PIRQC=%PIRUN ;RUNTIME ALARMCLOCK
061 190 006 INTGRP REALCLOCK,PIRQC=%PIRLT ;REAL TIME ALARMCLOCK
062
063 181 046 LINTVEC==:.-INTVEC ;LENGTH OF INTERRUPT VECTOR
064
065 ;;; NOTE THE EFFECT OF HAVING THE ALARMCLOCKS LAST:
066 ;;; IOC AND CHANNEL INTERRUPT HAPPEN FIRST, BUT WHEN
067 ;;; THE PION HAPPENS INSIDE UINT0 THE ALARMCLOCK GETS
068 ;;; ITS TURN IMMEDIATELY. FURTHERMORE, THE REAL TIME
069 ;;; CLOCK GETS SLIGHTLY HIGHER PRECEDENCE.
070 ] ;END OF IFN ITS
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 182
001
002 ;;; IFN QIO
003
004 002 029 IFN SAIL,[
005
006 028 050 WARN [CHECK FOR INTPDL OVERFLOW?]
007
008 SAILINT:
009 028 050 MOVE FXP,INTPDL
010 PUSH FXP,10 ;SAVE THE INTERRUPT DATUM
011 028 050 MOVEM FXP,INTPDL
012 UWAIT
013 028 050 EXCH F,INTPDL
014 SETZM 1,(F)
015 INTDMP 1(F)
016 006 115 HALT
017 028 050 PUSH F,INTPDL
018 181 046 PUSH F,D
019 064 009 ADD F,R70+1
020 PUSH F,.JBTPC
021 071 024 PUSH F,R
022 PUSH F,.JBCNI
023 028 050 MOVEM F,INTPDL
024 181 046 MOVE D,.JBCNI
025 181 046 JFFO D,.+2
026 006 115 HALT
027 071 024 IMSKCL SAMSKS(R)
028 DEBREAK
029 209 011 JRST SAINTS(R)
030
031 064 014 INTXIT: IMSKCL XC-1
032 028 050 MOVE F,INTPDL
033 071 024 MOVEI R,-3(F)
034 071 024 MOVEM R,SAINTFOO
035 181 046 MOVE D,...(F)
036 071 024 MOVE R,...(F)
037 POPI F,...
038 028 050 MOVEM F,INTPDL
039 MOVE F,...(F)
040 INTDEJ @SAINTFOO
041
042 ] ;END OF IFN SAIL
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 183
001
002 ;;; IFN QIO
003
004 ;;; WHEN THE INTERRUPT OCCURS, ACS D, R, AND F HAVE BEEN SAVED.
005 ;;; BY CONVENTION AN INTERRUPT HANDLER MOVES THE INTPDL POINTER
006 ;;; INTO F, GETS A VALID FXP POINTER INTO FXP, AND PUSHES THE OLD
007 ;;; CONTENTS OF FXP ONTO THAT PDL.
008
009 ;;; STANDARD INTERRUPT EXIT
010 ;;; WILL RESTORE FXP AND D+R+F, AND DISMISS THE INTERRUPT.
011
012 INTXIT: MOVE FXP,(FXP) ;POP FXP,FXP
013 015 019 SKIPN NOQUIT ;CHECK FOR USER INTS STACKED BY INT HANDLER
014 066 021 SKIPN INTFLG .SEE CHECKI
015 183 024 JRST INTXT2
016 024 064 SKIPE GCFXP ;HOW CAN GCFXP BE NON-ZERO WITH NOQUIT ZERO?
017 006 121 .LOSE
018 020 015 WARN [SHOULD HAVE A BETTER CHECK ON WHETHER THE INT WAS STACKED DURING THE INT SERVER]
019 028 038 PUSH FXP,IPSD(F) ;ARRANGE TO RESTORE D AND THE PC
020 028 037 PUSH P,IPSPC(F) ; (INCLUDING FLAGS!) AFTER CHECKING
021 059 052 PUSH P,CPXDFLJ ; FOR STACKED INTERRUPTS
022 201 002 MOVEI R,CKI0
023 028 037 MOVEM R,IPSPC(F)
024 183 027 INTXT2: .CALL INTXT9 ;RETURN PC IS ON TOP OF INTPDL,
025 006 121 .LOSE 1000 ; AND ALSO THE OLD DEFER WORDS
026
027 131 052 INTXT9: SETZ
028 SIXBIT \DISMIS\ ;DISMISS INTERRUPT
029 5000,,D←6+3 ;POP ACS D, R, AND F FIRST
030 028 050 400000,,INTPDL ;INTERRUPT STACK POINTER
031
032 ;;; STANDARD LOSING INTERRUPT EXIT
033 ;;; RESTORES FXP, AND D+R+F AS INTXIT DOES.
034 ;;; ALSO EXPECTS A .LOSE ERROR CODE IN R.
035
036 INTLOS: MOVE FXP,(FXP) ;POP FXP,FXP
037 183 040 INTLS1: .CALL INTLS9
038 006 121 .LOSE 1000
039
040 131 052 INTLS9: SETZ
041 SIXBIT \DISMIS\ ;DISMISS INTERRUPT
042 5000,,D←6+3 ;POP ACS D, R, AND F FIRST
043 028 050 ,,INTPDL ;INTERRUPT STACK POINTER
044 028 037 ,,IPSPC(F) ;NEW PC ;IN ORDER TO SPECIFY
045 028 035 ,,IPSDF1(F) ;NEW .DF1 ; THE .LOSE CODE, ONE
046 028 036 ,,IPSDF2(F) ;NEW .DF2 ; MUST MENTION ALL THIS TOO
047 071 024 400000,,R ;.LOSE ERROR CODE
048
049 ;;; EXIT INTERRUPT, GOING TO USER INTERRUPT HANDLER.
050 ;;; ARGUMENT FOR THE UINT ROUTINE IS IN D.
051 ;;; PDLS ARE IN GOOD SHAPE BY NOW, OF COURSE.
052
053 024 064 XUINT: SKIPE GCFXP ;BE EXTRA SURE ABOUT THE
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 183.1
054 006 121 .LOSE ; GOODNESS OF THE PDLS!
055 MOVE FXP,(FXP) ;POP FXP,FXP ;AT THIS POINT SHOULD BE SAME AS SUB FXP,R70+1
056 028 037 PUSH P,IPSPC(F) ;PUSH INTERRUPT PC ON STACK FOR UINT
057 059 052 PUSH P,CPXDFLJ ;ARRANGE FOR AC D AND FLAGS TO BE RESTORED
058 028 038 PUSH FXP,IPSD(F) ;PUSH AC D (BEFORE INTERRUPT) ON FXP
059 028 038 MOVEM D,IPSD(F) ;CAUSE D TO SURVIVE THE DISMIS
060 183 063 .CALL XUINT9
061 006 121 .LOSE 1000
062
063 131 052 XUINT9: SETZ
064 SIXBIT \DISMIS\ ;DISMISS INTERRUPT
065 5000,,D←6+3 ;POP ACS D, R, AND F FIRST
066 028 050 ,,INTPDL ;INTERRUPT STACK POINTER
067 196 007 1000,,UINT ;NEW PC
068 181 057 ,,TTYDF1 ;NEW .DF1
069 181 058 400000,,TTYDF2 ;NEW .DF2
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 184
001
002 ;;; IFN QIO
003
004 ;;; MEMORY AND OPCODE ERRORS: PARITY, PURE, MPV, ILOP.
005 ;;; ASSUME NO MORE THAN ONE HAPPENS AT A TIME.
006
007 012 037 MEMERR: .SUSET [.RJPC,,JPCSAV]
008 028 050 MOVE F,INTPDL
009 181 046 MOVE D,FXP
010 024 064 SKIPE GCFXP
011 024 064 MOVE FXP,GCFXP
012 181 046 PUSH FXP,D
013 028 033 MOVN R,IPSWD1(F) ;THIS SEQUENCE KILLS THE LOW-ORDER
014 028 033 ANDCA R,IPSWD1(F) ; BIT FROM THE INTERRUPT WORD
015 071 024 SKIPE R ;LOSE IF MORE THAN ONE BIT WAS SET
016 006 121 .LOSE
017 028 033 MOVE R,IPSWD1(F)
018 028 037 HRRZ D,IPSPC(F)
019 012 004 CAIN D,THIRTY+5 ;DDT DOES }X IN LOCATION 34
020 184 065 JRST $XLOSE
021 071 024 TLNE R,(%PI<PAR>) ;WAS IT A PARITY ERROR?
022 184 039 JRST PARERR
023 071 024 TLNE R,(%PI<WRO>) ;WRITE INTO READ-ONLY?
024 193 008 JRST PURPGI
025 071 024 TRNE R,%PI<ILO> ;ILLEGAL OPERATION?
026 184 038 JRST ILOPER
027 071 024 TRNN R,%PI<MPV> ;MEMORY PROTECT VIOLATION?
028 .VALUE ;NO??? WHAT HAPPENED???
029 049 020 CAIE D,UBD1 ;LET SPECPDL RESTORATION HAPPEN
030 184 034 JRST MPVERR ; EVEN IF ONE SLOT GOT CLOBBERED
031 028 037 AOS IPSPC(F) ;BUMP PC PAST OFFENDING INSTRUCTION
032 182 031 JRST INTXIT
033
034 184 059 MPVERR: SKIPA D,[UIMMPV]
035 184 058 PURERR: MOVEI D,UIMWRO
036 184 040 JRST MEMER5
037
038 184 057 ILOPER: SKIPA D,[UIMILO]
039 184 056 PARERR: MOVEI D,UIMPAR
040 028 050 MEMER5: HRRZ R,INTPDL ;MACHINE ERROR! WHAT TO DO?
041 028 050 CAIN R,INTPDL+LIPSAV ;IF THE ERROR HAPPENED WITHIN AN INTERRUPT SERVER,
042 SKIPN VMERR ; OR IF USER SUPPLIED NO ERROR FUNCTION,
043 184 051 JRST MEMER7 ; CRAP OUT BACK TO DDT
044 181 046 MOVEI D,100000(D)
045 028 037 HRL D,IPSPC(F)
046 227 015 PUSHJ FXP,IWAIT
047 183 053 JRST XUINT ;CALL USER INTERRUPT HANDLER
048 ; JRST INTXIT ;MAY RE-DO LOSING INSTR, BUT SO WHAT?
049 ; THAT'S A FEATURE, NOT A BUG.
050 181 046 ANDI D,777
051 184 054 MEMER7: HRRZ R,MEMER8(D)
052 183 036 JRST INTLOS
053
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 184.1
054 MEMER8:
055 OFFSET -.
056 UIMPAR:: 1+.LZ %PIPAR
057 UIMILO:: 1+.LZ %PIILO
058 UIMWRO:: 1+.LZ %PIWRO
059 UIMMPV:: 1+.LZ %PIMPV
060 OFFSET 0
061
062 $XLOST: .VALUE [ASCIZ \:} YOUR }↔}⊗X LOST }↔PROCEED⊗ \]
063 012 004 JRST THIRTY+5 ;LET THE }X RETURN CORRECTLY
064
065 184 062 $XLOSE: MOVEI R,$XLOST ;CAUSE INTERRUPT DURING AN }X
066 028 037 MOVEM R,IPSPC(F) ; TO GO TO $XLOST (CROCK)
067 182 031 JRST INTXIT
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 185
001
002 ;;; IFN QIO
003
004 ;;; I/O CHANNEL ERROR HANDLER
005
006 028 050 IOCERR: MOVE F,INTPDL
007 071 024 MOVE R,FXP
008 024 064 SKIPE GCFXP
009 024 064 MOVE FXP,GCFXP
010 071 024 PUSH FXP,R
011 071 024 .SUSET [.RBCHN,,R]
012 071 024 SKIPN R
013 185 030 JRST IOCER8
014 130 094 .CALL SCSTAT
015 006 121 .LOSE 1400
016 181 046 LSH D,-33
017 028 037 HRRZ R,IPSPC(F)
018 011 011 MACROLOOP NIOCTR,ZZI,* ;ZZI MACROS DEFINE IOC TRAPS
019 071 024 SKIPL R
020 185 030 JRST IOCER8
021 028 037 HRRM R,IPSPC(F) ;CLOBBER RETURN PC
022 071 024 HLRZ R,R
023 071 024 CAIN R,400000+D ;WANT TO STICK IOC ERROR
024 028 034 MOVEI R,400000-IPSWD2(F) ; CODE INTO SPECIFIED AC,
025 071 024 CAIN R,400000+R ; BUT MUST BEWARE OF D AND R
026 028 033 MOVEI R,400000-IPSWD1(F)
027 071 024 MOVEM D,-400000(R)
028 182 031 JRST INTXIT
029
030 071 024 IOCER8: MOVEI R,1+.LZ %PIIOC
031 183 036 JRST INTLOS
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 186
001
002 ;;; IFN QIO
003
004 ;;; INTERRUPT FROM I/O CHANNEL.
005 ;;; PRESENTLY ONLY TWO KINDS ARE HANDLED:
006 ;;; TTY INPUT: INTERRUPT CHAR TYPED.
007 ;;; TTY OUTPUT: **MORE**.
008
009 028 050 CHNINT: MOVE F,INTPDL
010 028 034 MOVE D,IPSWD2(F) ;GET WORD TWO INTERRUPT BITS
011 071 024 MOVE R,FXP ;FXP MAY BE IN A BAD STATE IF
012 024 064 SKIPE GCFXP ; WITHIN GC, SO RESTORE IT AND
013 024 064 MOVE FXP,GCFXP ; THEN PUSH ITS OLD VALUE
014 071 024 PUSH FXP,R ;REMEMBER, PDL OVERFLOW ISN'T DEFERRED NOW
015 071 024 MOVN R,D
016 071 024 AND R,D ;R GETS LOWEST SET BIT
017 071 024 ANDCM D,R ;D GETS ALL OTHER BITS
018 181 046 SKIPE D
019 181 046 .SUSET [.SIIFPIR,,D] ;PUT ANY OTHER BITS BACK (THEY'RE DEFERRED)
020 071 024 MOVE D,R
021 181 046 JFFO D,.+1 ;FIND CHANNEL NUMBER
022 071 024 MOVNS R ; FOR SOME PENDING
023 071 024 ADDI R,43 ; INTERRUPT BIT
024 071 024 PUSH FXP,R ;SAVE CHANNEL NUMBER
025 071 024 SKIPE R ;CHANNEL 0 ??
026 017 019 SKIPN CHNTB(R) ;UNOPEN DEVICE ??
027 .VALUE
028 130 094 CHNI1H: .CALL SCSTAT ;GET STATUS FOR THE CHANNEL
029 .VALUE
030 181 046 ANDI D,77 ;GET ITS INTERNAL PHYSICAL DEVICE TYPE
031 181 046 SKIPE D
032 181 046 CAILE D,2
033 187 014 JRST CHNI5
034 017 019 HRRZ D,CHNTB(R)
035 181 046 MOVE D,TTSAR(D)
036 181 046 TLNE D,TTS<IO>
037 187 014 JRST CHNI5
038 071 024 .ITYIC R, ;TYPE 0 IS TTY INPUT
039 187 021 JRST CHNI8 ;TIMING ERROR OR SOMETHING - IGNORE
040 071 024 PUSH FXP,R ;SAVE INTERRUPT CHARACTER
041 PUSH FXP,TT ; AND ALSO TT
042 HRRZ TT,-2(FXP) ;FETCH CHANNEL NUMBER
043 017 019 HRRZ TT,CHNTB(TT)
044 HRRZ TT,TTSAR(TT)
045 189 009 JSP D,TTYICH ;GET BACK INTERRUPT FN IN R
046 POP FXP,TT
047 186 082 JUMPE R,CHNI2 ;NULL FUNCTION - IGNORE
048 071 024 MOVEI D,(R)
049 005 042 LSH D,-SEGLOG
050 036 033 MOVE D,ST(D)
051 181 046 TLNN D,FX
052 187 004 JRST CHNI4
053 071 024 MOVE R,(R) ;"FUNCTION" IS A FIXNUM
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 186.1
054 071 024 MOVEI D,(R) ;IF ANY OF THE SUPRA-ASCII
055 181 046 ANDCM D,(FXP) ; MODIFIER BITS ARE SET IN THE
056 MOVSS (FXP) ; "FUNCTION", INSIST THAT THE
057 071 024 ANDM R,(FXP) ; CORRESPONDING BITS APPEAR IN
058 MOVSS (FXP) ; THE CHARACTER TYPED. SIMILARLY,
059 181 046 IOR D,(FXP) ; THE SAME BITS SET IN THE LEFT HALF
060 181 046 TRNE D,%TX<MTA+CTL+TOP+SFT+SFL> ; MEAN THAT THOSE BITS MUST BE OFF.
061 186 082 JRST CHNI2
062 071 024 ANDI R,177
063 181 046 MOVEI D,TRUTH ;MOOOOBY SKIP CHAIN OF SYSTEM INTS
064 035 006 CAIN R,↑C ;↑C (SETQ ↑D NIL)
065 SETZM GCGAGV
066 071 024 CAIN R,↑D ;↑D (SETQ ↑D T)
067 181 046 HRRZM D,GCGAGV
068 071 024 CAIN R,↑G ;↑G (↑G) ;QUIT
069 189 050 JRST CN.G
070 071 024 CAIN R,↑R ;↑R (SETQ ↑R T)
071 181 046 HRRZM D,TAPWRT
072 071 024 CAIN R,↑T ;↑T (SETQ ↑R NIL)
073 SETZM TAPWRT
074 071 024 CAIN R,↑V ;↑V (SETQ ↑W NIL)
075 SETZM TTYOFF
076 071 024 CAIN R,↑W ;↑W (PROG2 (SETQ ↑W T)
077 189 024 JRST CN.W ; (CLEAR-OUTPUT T))
078 071 024 CAIN R,↑X ;↑X (ERROR 'QUIT) ;↑X QUIT
079 189 049 JRST CN.X
080 071 024 CAIN R,↑Z ;↑Z CRAP OUT TO DDT
081 177 054 JRST CN.Z
082 064 009 CHNI2: SUB FXP,R70+2
083 182 031 JRST INTXIT
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 187
001
002 ;;; IFN QIO
003
004 181 046 CHNI4: POP FXP,D ;REAL LIVE USER INTERRUPT FUNCTION
005 181 046 TRO D,400000 ;2.9 => TTY INPUT INTERRUPT CHAR
006 071 024 CHNI4A: POP FXP,R
007 017 019 HRL D,CHNTB(R)
008 015 026 SKIPE UNREAL
009 187 027 JSP R,CHNI4C ;BARF! (NOINTERRUPT 'TTY) OR (NOINTERRUPT T)
010 227 015 PUSHJ FXP,IWAIT ;CALLS UISTAK AND SKIPS IF IN GC
011 183 053 JRST XUINT ;RUNS USER INTERRUPT
012 182 031 JRST INTXIT
013
014 017 019 CHNI5: HRRZ D,CHNTB(R) ;CHECK OUT FILE ARRAY
015 181 046 HRRZ D,TTSAR(D)
016 019 012 SKIPN FO.EOP(D) ;SKIP IF ENDPAGEFN
017 187 021 JRST CHNI8
018 019 012 MOVEI D,200000+<2*FO.EOP+1> ;2.8 => RANDOM FILE INTERRUPT
019 187 006 JRST CHNI4A ;**MORE** => ENDPAGEFN GETS RUN
020
021 064 009 CHNI8: SUB FXP,R70+1
022 182 031 JRST INTXIT
023
024
025 ;;; ROUTINE TO STACK UP INTERRUPT IN INTAR -- USED BY CHNINT, JOBINT, AND FNYINT
026
027 028 023 CHNI4C: MOVE F,UNREAR ;STACK UP INTERRUPT IN THE
028 028 015 CAIL F,LUNREAR ; NOINTERRUPT QUEUE
029 192 025 JRST TMDAMI ;OOPS! TOO MANY DAMN INTERRUPTS!
030 028 023 MOVE F,[400000+LUNREAR-1,,UNREAR+LUNREAR-2]
031 CHNI4H: POP F,1(F)
032 TLNE F,377777
033 187 031 JRST CHNI4H
034 028 023 MOVEM D,UNREAR+1
035 028 023 AOS UNREAR
036 028 050 HRRZ F,INTPDL
037 209 011 JRST 2(R)
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 188
001
002 ;;; IFN QIO
003
004 ; COMMENT FOR @ CHANGE
005
006 002 049 IFN JOBQIO,[
007
008 ;;; INTERRUPT FROM INFERIOR PROCEDURE(S)
009
010 028 050 JOBINT: MOVE F,INTPDL
011 028 034 MOVE D,IPSWD2(F)
012 071 024 MOVE R,FXP
013 024 064 SKIPE GCFXP ;IF IN GC, FXP MAY BE
014 024 064 MOVE FXP,GCFXP ; SCREWED UP
015 071 024 PUSH FXP,R
016 071 024 MOVN R,D
017 071 024 AND R,D ;R GETS LOWEST SET BIT
018 071 024 ANDCM D,R ;D GETS ALL OTHER BITS
019 181 046 SKIPE D
020 181 046 .SUSET [.SIIFPIR,,D] ;PUT ANY OTHER BITS BACK (THEY'RE DEFERRED)
021 071 024 MOVE D,R
022 181 046 JFFO D,.+1
023 071 024 MOVNS R ;-22 < R < -11
024 017 039 SKIPN D,JOBTB+21(R)
025 .VALUE ;NO JOB ARRAY???
026 071 024 HRRZ R,TTSAR(D)
027 071 024 SKIPN J.INTF(R)
028 182 031 JRST INTXIT ;NO INTERRUPT FUNCTION - IGNORE INTERRUPT
029 181 046 MOVSI D,(D)
030 181 046 TRO D,200000+<2*J.INTF+1>
031 015 026 SKIPGE UNREAL
032 187 027 JSP R,CHNI4C ;GORP! (NOINTERRUPT T)
033 227 015 PUSHJ FXP,IWAIT
034 183 053 JRST XUINT
035 182 031 JRST INTXIT
036
037 ] ;END OF IFN JOBINT
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 189
001
002 ;;; IFN QIO
003
004 ;;; TTSAR OF TTY INPUT FILE ARRAY IN TT.
005 ;;; INPUT INTERRUPT CHARACTER IN R.
006 ;;; RETURN ADDRESS IN D.
007 ;;; RETURNS INTERRUPT FUNCTION IN R.
008
009 071 024 TTYICH: TRZ R,%TX<TOP+SFL+SFT+MTA> ;FOLD 12.-BIT CHAR
010 071 024 TRZN R,%TX<CTL> ; DOWN TO 7 IF NECESSARY
011 189 014 JRST TTYIC1
012 071 024 CAIE R,177
013 071 024 TRZ R,140
014 071 024 TTYIC1: ROT R,-1 ;CLEVER ARRAY ACCESS
015 018 062 ADDI TT,FB.BUF(R) ;INTERRUPT FNS ARE IN "BUFFER"
016 071 024 HLR R,(TT)
017 071 024 SKIPGE R
018 071 024 HRRZ R,(TT) ;SIGN BIT OF R GETS CLEARED
019 209 011 JRST (D)
020
021
022 ;;; VARIOUS SYSTEM TTY INPUT CHAR INTERRUPT HANDLERS.
023
024 181 046 CN.W: HRRZM D,TTYOFF ;IMMEDIATE TTYOFF (↑W)
025 PUSH FXP,T
026 PUSH FXP,TT
027 HRRZ TT,V%TYO
028 MOVE TT,TTSAR(TT)
029 PUSHJ FXP,CLRO3 ;ALSO DO (CLEAR-OUTPUT T)
030 POP FXP,TT
031 POP FXP,T
032 186 082 JRST CHNI2
033
034 201 099 CN.Z: .CALL CKI2I ;***** CROCK *****
035 .VALUE
036 .VALUE [ASCIZ \:}DDT}
037 \]
038 186 082 JRST CHNI2
039
040 181 046 CTRLG: HRROI D,-3 ;↑G - SUBR 0
041 064 009 .SUSET [.SPICLR,,R70] ;DISABLE THE INTERRUPT SYSTEM FOR NOW
042 028 023 SETZM UNREAR ;CLEAR OUT ALL STACKED INTERRUPTS
043 028 010 SETZM INTAR
044 015 012 HRREM D,INTFLG
045 015 019 SKIPE NOQUIT ;HOW CAN NOQUIT BE NON-ZERO?
046 006 121 .LOSE ; MAYBE THE USER SCREWED UP
047 201 002 JRST CKI0 ;PROCESS THE FORCED QUIT
048
049 181 046 CN.X: SKIPA D,[-6] ;ERRSETABLE (↑X) QUIT
050 181 046 CN.G: HRROI D,-7 ;IMMEDIATE (↑G) QUIT
051 015 026 SKIPE UNREAL
052 189 061 JRST CN.G1
053 028 010 SETZM INTAR ;KILL ALL INTERRUPTS STACKED UP
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 189.1
054 015 012 HRREM D,INTFLG
055 227 015 PUSHJ FXP,IWAIT
056 201 002 SKIPA D,[CKI0]
057 186 082 JRST CHNI2 ;CAN'T PROCESS QUIT NOW
058 028 037 MOVEM D,IPSPC(F) ;IF CAN QUIT NOW, ARRANGE FOR SERVER
059 186 082 JRST CHNI2 ; TO RETURN TO INTERRUPT CHECKER
060
061 028 023 CN.G1: SETZM UNREAR ;KILL STACKED UNREAL INTERRUPTS
062 028 018 EXCH D,UNRC.G ;ELSE STACK UP AN UNREAL
063 181 046 TRNE D,1 ; ↑G OR ↑X INTERRUPT
064 028 018 MOVEM D,UNRC.G ;DON'T LET A ↑X DISPLACE A ↑G
065 186 082 JRST CHNI2
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 190
001
002 ;;; IFN QIO
003
004 ;;; REAL TIME ALARMCLOCK
005
006 REALCLOCK:
007 071 024 MOVSI R,400000 ;SHUT CLOCK BACK OFF
008 071 024 .REALT R,
009 071 024 MOVEI R,QTIME
010 190 016 JRST RCLOK1
011
012 ;;; RUNTIME ALARMCLOCK
013
014 RUNCLOCK:
015 071 024 MOVEI R,Q$RUNTIME
016 028 050 RCLOK1: MOVE F,INTPDL
017 181 046 MOVE D,FXP
018 024 064 SKIPE GCFXP
019 024 064 MOVE FXP,GCFXP
020 181 046 PUSH FXP,D
021 SKIPN VALARMCLOCK ;IGNORE IF THERE IS NO
022 182 031 JRST INTXIT ; ALARMCLOCK FUNCTION
023 071 024 MOVSI D,(R) ;TYPE 0, SUBTYPE 0 IS ALARMCLOCK
024 015 026 SKIPL UNREAL ;SKIP IF (NOINTERRUPT T)
025 190 042 JRST RCLOK2
026 028 021 MOVEM D,UNRRUN-Q$RUNTIME(R) ;STACK UP INTERRUPT
027 182 031 JRST INTXIT
028
029 002 051 IFN USELESS,[
030 028 050 FNYINT: MOVE F,INTPDL ;COMMON HANDLER FOR FUNNY INTERRUPTS
031 181 046 MOVE D,FXP
032 024 064 SKIPE GCFXP
033 024 064 MOVE FXP,GCFXP
034 181 046 PUSH FXP,D
035 071 024 MOVE R,(R)
036 071 024 SKIPN (R)
037 182 031 JRST INTXIT ;EXIT IF NO USER HANDLER
038 071 024 HLRZ D,R
039 015 026 SKIPGE UNREAL
040 187 027 JSP R,CHNI4C ;MUST STACK UP IF UNREAL
041 ] ;END OF IFN USELESS
042 227 015 RCLOK2: PUSHJ FXP,IWAIT ;WILL STACK AND SKIP IF GC
043 183 053 JRST XUINT ;GIVE USER CLOCK INTERRUPT
044 182 031 JRST INTXIT
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 191
001
002 ;;; IFN QIO
003
004 002 051 IFN USELESS,[
005
006 ;;; CLI INTERRUPT HANDLER
007
008 190 030 CLIINT: JSP R,FNYINT
009 195 038 UIFCLI,,VCLI
010
011 ;;; RETURN OF TTY TO THE JOB
012
013 190 030 TTRINT: JSP R,FNYINT
014 195 040 UIFTTR,,VTTR
015
016 ;;; SYSTEM GOING DOWN OR BEING DEBUGGED
017
018 190 030 SYSINT: JSP R,FNYINT
019 195 041 UIFSYS,,VSYSD
020
021 ;;; MAR BREAK
022
023 071 024 MARINT: MOVEI R,%PIMAR
024 015 046 ANDCAM R,IMASK
025 015 046 .SUSET [.SMASK,,IMASK]
026 064 009 .SUSET [.SMARA,,R70]
027 071 024 MOVEI R,1+.LZ %PIMAR
028 SKIPN VMAR
029 183 037 JRST INTLS1 ;IN CASE (STATUS MAR) GETS LOUSED UP
030 190 030 JSP R,FNYINT
031 195 039 UIFMAR,,VMAR
032
033 ] ;END OF IFN USELESS
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 192
001
002 ;;; IFN QIO
003
004 ;;; STACK UP A USER INTERRUPT WHICH MUST BE DELAYED.
005 ;;; ARGUMENT IS IN D AS FOR UINT; IT IS SAVED IN THE INTAR QUEUE.
006 ;;; ASSUMES FREE USE OF ACCUMULATOR R.
007 ;;; PI INTERRUPTS MUST BE DISABLED!!!!
008 .SEE PIOF
009
010 016 004 YESIN1: POP P,UISTAK ;THIS IS A HORRIBLE CROCK
011 ;UISTAK: 0
012 015 012 UISTK1: MOVE R,INTFLG ;IF WE ARE ABOUT TO QUIT ANYWAY,
013 016 004 AOJL R,@UISTAK ; THEN FORGET THE WHOLE THING
014 028 010 AOS R,INTAR
015 028 007 CAILE R,LINTAR
016 192 025 JRST TMDAMI ;TOO MANY DAMN INTERRUPTS
017 028 010 MOVE R,[400000+LINTAR-1,,INTAR+LINTAR-2]
018 071 024 UISTK2: POP R,1(R)
019 071 024 TLNE R,377777
020 192 018 JRST UISTK2
021 028 010 MOVSM D,INTAR+1
022 015 012 SETOM INTFLG
023 016 004 JRST @UISTAK
024
025 024 064 TMDAMI: SKIPN GCFXP ;TOO MANY DAMN INTERRUPTS
026 192 030 JRST TMDAM2
027 IRP X,,[P,FLP,FXP,SP]
028 MOVE X,GC!X
029 TERMIN
030 TMDAM2:
031 ; LERR [SIXBIT \TOO MANY DEFERRED INTERRUPTS!\]
032 .VALUE [ASCIZ \:}TOO MANY DEFERRED INTERRUPTS}↔CONTIN⊗
033 \]
034 006 121 .LOSE
035 ] ;END OF IFN QIO
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 193
001
002 005 005 IFE D10,[
003
004 002 048 IFE QIO,[
005
006 ;;; PURE PAGE TRAP HANDLER
007
008 020 018 PURPGI: MOVEM A,INTSV ;TRIED TO WRITE INTO A PURE PAGE
009 020 016 HRRZ A,IPCLOK
010 050 020 CAIN A,STQPUR+1
011 193 020 JRST PPGI5
012 011 010 MACROLOOP NPURTR,ZZP,*, ;ZZP MACROS DEFINE WHAT PLACES HAVE HANDLERS
013 193 017 JUMPGE A,PPGI2
014 020 016 PPGI3: HRRM A,IPCLOK
015 177 049 JRST INTEX
016
017 PPGI2: MOVEI A,4 ;LOSE LOSE - A BAD ERROR
018 209 011 JRST PPGI4
019
020 020 015 PPGI5: EXCH A,INT ;REMEMBER WHICH VALUE CELL WE TRIED TO GRONK
021 032 046 MOVEM A,STQLUZ
022 MOVE A,[TIRPATE,,NIL]
023 MOVEM A,(SP)
024 032 046 MOVE A,STQLUZ
025 020 015 EXCH A,INT
026 016 008 JSR INTWAIT ;LET SPDL GET CAUGHT UP, IF LAMBDA OR SET BINDING
027 032 046 SKIPA T,STQLUZ ;ERROR HANDLER WANTS LOCATION IN T
028 193 017 JRST PPGI2 ;IN CASE INTWAIT SKIPS
029 PPGI6: HRRZI A,NILSETQ ;TRIED TO PUT A VALUE PROPERTY ON NIL
030 193 014 JRST PPGI3
031
032 ; ENDCODE [PURPGI]
033
034 ] ;END OF IFE QIO
INTERRUPT HANDLERS LISP.393[MAC,LSP] 01/17/78 Page 194
001
002 002 048 IFN QIO,[
003
004 ; PUTCODE [QIO PURPGI]\20+2*NPURTR,INT,GC
005
006 ;;; PURE PAGE TRAP HANDLER
007 ;;; COMES HERE WITH LOSING PC IN D.
008 184 007 .SEE MEMERR
009
010 050 020 PURPGI: CAIN D,STQPUR
011 193 020 JRST PPGI5
012 011 010 MACROLOOP NPURTR,ZZP,*, ;ZZP MACROS DEFINE WHAT PLACES HAVE HANDLERS
013 184 035 JUMPGE D,PURERR
014 028 037 PPGI3: HRRM D,IPSPC(F)
015 182 031 JRST INTXIT
016
017 032 046 PPGI5: MOVEM A,STQLUZ ;REMEMBER WHICH VALUE CELL WE TRIED TO GRONK
018 181 046 MOVE D,[TIRPATE,,NIL]
019 181 046 MOVEM D,(SP)
020 024 064 SKIPE GCFXP
021 .VALUE
022 028 037 AOS IPSPC(F) ;DON'T RETRY THE LOSING INSTRUCTION!
023 227 015 PUSHJ FXP,IWAIT ;LET SPDL GET CAUGHT UP
024 032 046 SKIPA T,STQLUZ ;ERROR HANDLER WANTS LOCATION IN T
025 184 035 JRST PURERR ;INTWAIT MAY SKIP
026 181 046 PPGI6: HRRZI D,NILSETQ ;TRIED TO PUT A VALUE PROPERTY ON NIL
027 193 014 JRST PPGI3
028
029 ; ENDCODE [QIO PURPGI]
030
031 ] ;END OF IFN QIO
032
033 ] ;END OF IFE D10
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 195
001
002 SUBTTL USER INTERRUPT ROUTINES
003
004 ;;; USER INTERRUPT TYPES FOR NEWIO
005 ;;;
006 ;;; FORM OF ARGUMENT TO UINT (ALSO STORED IN THIS FORM
007 ;;; IN INTAR, ONLY WITH HALVES SWAPPED; WHY, I DON'T KNOW):
008 ;;;
009 ;;; 4.9-3.1 ARGUMENT FOR INTERRUPT FUNCTION
010 ;;; 2.9 IF 1, SPECIFIES A TTY INPUT CHARACTER INTERRUPT.
011 ;;; ARGUMENT IS TTY INPUT FILE ARRAY.
012 ;;; 2.8-2.4 MUST BE ZERO.
013 ;;; 2.3-1.1 CHARACTER WHICH CAUSED INTERRUPT, AS
014 ;;; READ BY .ITYIC. THIS MAY BE A 12.-BIT
015 ;;; CHARACTER, AND SO MAY HAVE TO BE FOLDED
016 ;;; BEFORE SELECTING THE INTERRUPT FUNCTION.
017 ;;; THIS IS PASSED AS THE SECOND ARGUMENT.
018 ;;; 2.8 IF 1, SPECIFIES AN INTERRUPT RELATED TO A FILE
019 ;;; ARRAY OR SIMILAR OBJECT, E.G. THE **MORE**
020 ;;; INTERRUPT FOR TTY OUTPUT.
021 ;;; ARGUMENT IS THE FILE ARRAY.
022 ;;; 2.7-1.1 IS THE INDEX OF THE INTERRUPT FUNCTION
023 ;;; WITHIN THE ARRAY, WHERE THE LOW BIT SPECIFIES
024 ;;; LEFT OR RIGHT HALF AS USUAL.
025 ;;; 2.7 IF 1, SPECIFIES A MACHINE ERROR.
026 ;;; THE ARGUMENT IS THE LOCATION OF THE LOSS.
027 ;;; BITS 1.9-1.1 SPECIFY THE NATURE OF THE ERROR.
028 UIMPAR==:0 ;ODDP ;PARITY ERROR
029 UIMILO==:1 ;EVAL ;ILLEGAL OPERATION
030 UIMWRO==:2 ;DEPOSIT ;WRITE INTO READ-ONLY MEMORY
031 UIMMPV==:3 ;EXAMINE ;MEMORY PROTECT VIOLATION
032 ;;; IF 2.9-2.7 ARE ZERO, THEN:
033 ;;; 2.2-2.1 TYPE OF INTERRUPT
034 ;;; 1.9-1.1 SPECIFIC INTERRUPT
035 ;;; CURRENT TYPES AND SPECIFIC INTERRUPTS ARE:
036 ;;; 0 RANDOM ASYNCHRONOUS (DELAYED BY (NOINTERRUPT T))
037 ;;; 0 ALARMCLOCK
038 UIFCLI==:1 ;CLI-MESSAGE ;USELESS
039 UIFMAR==:2 ;MAR-BREAK ;USELESS
040 UIFTTR==:3 ;TTY-RETURN ;USELESS
041 UIFSYS==:4 ;SYS-DEATH ;USELESS
042 002 051 IFE USELESS, NUINT0==:1 .SEE GCP6Q6
043 002 051 IFN USELESS, NUINT0==:5 .SEE GCP6Q6
044 ;;; 1 RANDOM SYNCHRONOUS
045 ;;; 0 AUTOLOAD
046 ;;; 1 ERRSET FN
047 ;;; 2 *RSET-TRAP
048 ;;; 3 GC-DAEMON
049 ;;; 4 GC-OVERFLOW
050 ;;; 5 PDL-OVERFLOW
051 NUINT1==:6 .SEE GCP6Q6
052 ;;; 2 ERINT (SYNCHRONOUS)
053 ;;; 0 UNDF-FNCTN
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 195.1
054 ;;; 1 UNBND-VRBL
055 ;;; 2 WRNG-TYPE-ARG
056 ;;; 3 UNSEEN-GO-TAG
057 ;;; 4 WRNG-NO-ARGS
058 ;;; 5 GC-LOSSAGE
059 ;;; 6 FAIL-ACT
060 ;;; 7 IO-LOSSAGE
061 NUINT2==:10 .SEE GCP6Q6
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 196
001
002 ;;; FOR NON-QIO, WE DON'T PUSHJ HERE FROM PI LEVEL, UNLESS WE KNOW
003 ;;; THAT GC IS NOT IN PROGRESS (THUS WE HAVE A PDL).
004 ;;; FOR QIO, WE NORMALLY DON'T PUSHJ HERE AT ALL FROM PI LEVEL!
005 ;; (THINK ABOUT HOW TO SIMPLIFY THE CODE HERE.)
006
007 UINT:
008 Q% SKIPN @UINTTB(A) ;SERVICE USER INTERRUPT
009 081 044 Q% JRST FALSE
010 196 042 PUSHJ P,UINTPU
011 015 019 SKIPN NOQUIT
012 020 032 SKIPE INHIBIT
013 196 031 JRST UINT2
014 015 012 SKIPGE INTFLG
015 196 034 JRST UINT3
016 197 011 PUSHJ P,UINT0
017 UINTEX: SKIPL (FXP) ;PEOPLE COME HERE TO UNDO UINTPU
018 196 025 JRST UINTX1
019 Q% PION
020 002 048 IFN QIO,[
021 064 014 .SUSET [.SPICLR,,XC-1]
022 064 009 .SUSET [.SDF1,,R70]
023 064 009 .SUSET [.SDF2,,R70]
024 ] ;END OF IFN QIO
025 UINTX1: POPI FXP,1
026 196 042 Q$ POP FXP,R .SEE UINTPU
027 066 021 JRST CHECKI ;PDL-OVERFLOW MAY HAVE BEEN STACKED
028 016 018 Q% .SEE PDLHAK
029 Q$ .SEE PDLOV
030
031 016 004 UINT2: JSR UISTAK ;DELAY A USER INTERRUPT, SINCE INHIBIT SWITCH IS ON
032 196 017 JRST UINTEX
033
034 015 012 UINT3: HRRZ D,INTFLG ;CHECK INTERRUPT FLAG TO SEE THAT IS SAYS "QUIT"
035 181 046 CAIE D,-1 ;AND NOT SOME INCONGRUOUS USER PI
036 201 008 JRST CKI2
037 HHCTB: .VALUE
038 ; LERR EMS11 ;HOW THE HELL CAN THIS BE?
039
040
041
042 UINTPU: ;PUSH PI STATE, THEN DISABLE
043 002 026 IFN ITS,[
044 071 024 Q$ PUSH FXP,R ;SAVE R FOR UISTAK, ETC.
045 PUSH FXP,T
046 .SUSET [.RPICLR,,T]
047 EXCH T,(FXP)
048 SKIPGE (FXP)
049 177 014 Q% .SUSET PIHOLD
050 064 009 Q$ .SUSET [.SPICLR,,R70]
051 ] ;END OF IFN ITS
052 030 024 10$ PUSH FXP,UPCOK
053 030 024 10$ SETZM UPCOK
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 196.1
054 POPJ P,
055
056
057
058 002 048 IFE QIO,[
059
060 016 004 YESIN1: POP P,UISTAK ;CROCK, CROCK, CROCK!!!
061 ;UISTAK: 0
062 015 012 UISTK1: AOSGE INTFLG ;DONT WORRY, INTERRUPTS ARE SHUT OFF
063 196 077 JRST UINT4 ;USES QITD AND QITR, BUT NOT QITC
064 015 012 SETZM INTFLG
065 015 030 MOVEM D,QITD
066 015 031 MOVEM R,QITR ;STACK UP AN INTERRUPT IN THE DELAYED INTERRUPT ARRAY
067 028 010 AOS R,INTAR ;BECAUSE USER INTERRUPTS ARE NOT NOW ENABLED
068 028 007 CAILE R,LINTAR
069 LERR EMS12 ;TOO MANY INTERRUPTIONS
070 196 073 JRST UISTK3
071 028 010 UISTK2: MOVE D,INTAR(R)
072 028 010 MOVEM D,INTAR+1(R)
073 192 018 UISTK3: SOJG R,UISTK2
074 028 010 MOVSM A,INTAR+1
075 015 031 MOVE R,QITR
076 015 030 MOVE D,QITD
077 015 012 UINT4: SOS INTFLG
078 MOVEI A,0
079 016 004 JRST 2,@UISTAK
080
081 ] ;END OF IFE QIO
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 197
001
002 002 048 IFE QIO,[
003
004 ;;; SAVE WORLD - INCLUDES STATE OF PICL, VALUES OF ACCS 2 THRU 13
005 ;;; AND MOST WRITABLE SYSTEM TEMPS. THEN RUN THE ASSOCIATED ROUTINE.
006 ;;; INTERRUPTS MUST BE TURNED OFF WITH PIOF BEFORE COMING HERE.
007
008 015 019 YESINT: SKIPN NOQUIT
009 020 032 SKIPE INHIBIT
010 192 010 JRST YESIN1
011 UINT0: HRRZS (P)
012 SKIPGE UINTTB(A)
013 HRROS (P)
014 HRR A,@UINTTB(A) ;ARG IN LH, TABLE INDEX IN RH CONVERTED INTO INT FUN
015 PUSH P,A
016 UINT26: HLRZ A,P
017 197 038 CAIL A,LUINF
018 198 048 IT$ JRST UINT27
019 UINT42: HLRZ A,FXP
020 022 070 CAIL A,-<LSWS+6>
021 209 011 10$ JRST XPOV
022 .ELSE,[
023 198 052 JRST UINT43
024 UINT55: HLRZ A,SP
025 CAIL A,-4
026 198 056 JRST UINT56
027 ] ;END OF .ELSE
028 015 026 PUSH FXP,UNREAL
029 SKIPGE -1(P)
030 015 026 SETOM UNREAL
031 BG$ PUSH FXP,BNV1
032 022 070 ADD FXP,[LSWS+5,,LSWS+5]
033 061 007 PUSH P,[$UIFRAME]
034 PUSH P,FXP ;SAVE PDLS SO THAT IF FRETURN WANTS TO BREAK OUT
035 HRLM FLP,(P) ;OF A USER INTERRUPT, HE CAN DO SO CORRECTLY
036 060 005 PUSHJ FXP,SAV5M1
037 PUSH P,40 ;SAVE INTERPRETED ACS AND STUFF ON PDL TO GC PROTECT IT
038 LUINF==-<NACS-1>-1-2 ;LOCATION OF USER INTERRUPT FUNCTION ON PDL - WHERE A WENT
039 022 070 MOVEI A,-<LSWS+5>+1(FXP)
040 HRLI A,T
041 022 070 BLT A,-LSWS(FXP) ;SAVE NON-INTERPRETED ACS
042 022 070 MOVEI A,-<LSWS>+1(FXP)
043 020 013 HRLI A,SWS
044 BLT A,(FXP) ;SAVE SUPER-WRITABLE STUFF
045 048 005 JSP T,SPECBIND
046 0 NIL,TYIMAN ;EVIL VILLIANS, WE BIND TYI-MAN
047 0 NIL,TMBBC ; AND FORCE HIM TO DO OUR WILL!
048 0 NIL,LISAR
049 020 018 SETZM INTSV
050 020 031 SETZM PA4
051 021 055 IFN USELESS, SETZM TYOSW
052 020 032 SETZM INHIBIT
053 020 030 SETZM EOFRTN ;DO NOT SETZM CATRTN! GJS WANTS TO
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 197.1
054 020 034 SETOM RRDF ; THROW THROUGH USER INTERRUPTS
055 020 033 SETOM ERRSW
056 197 038 MOVEI A,LUINF+1(P)
057 020 046 MOVEM A,UIRTN
058 197 038 HLRZ A,LUINF(P)
059 197 038 HRRZS LUINF(P)
060 PION
061 197 038 CALLF 1,@LUINF(P) ;APPLY INTERRRUPT FUNCTION
062
063 ;FALLS THROUGH
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 198
001
002 ;FALLS IN
003
004 ;;; IFE QIO
005
006 PIOF
007 197 038 MOVEM A,LUINF(P) ;SETUP FOR RETURN VALUE
008 049 033 PUSHJ P,UNBIND ;RESTORE TYIMAN ETC.
009 022 070 UINT0X: HRLI A,-<LSWS+5>+1(FXP) ;RESTORE WORLD
010 HRRI A,T
011 BLT A,T+4
012 022 070 HRLI A,-<LSWS>+1(FXP)
013 020 013 HRRI A,SWS
014 020 013 BLT A,SWS+LSWS-1
015 022 070 SUB FXP,[LSWS+5,,LSWS+5]
016 BG$ POP FXP,BNV1
017 POP P,40
018 060 021 PUSHJ FXP,RST5M1
019 064 009 SUB P,R70+2 ;KNOCK OFF PDLS AND UIFRAME MARKER
020 POP FXP,A ;OLD STATE OF UNREAL
021 SKIPL -1(P) ;IF INTERRUPT TABLE DIDN'T HAVE BIT 4.9
022 059 035 JRST POPAJ ; ON, MUSTN'T ATTEMPT TO RESTORE UNREAL
023 015 026 EXCH A,UNREAL ;WELL, WE WANT TO RESTORE IT. WAS IT ON
024 059 035 JUMPE A,POPAJ ; JUST NOW? IF NOT, RETURN.
025 015 026 SKIPE UNREAL ;DID WE JUST TURN IT OFF BY RESTORING IT?
026 198 042 JRST UINT0Z ;NO, IT'S STILL ON - RETURN.
027 UINT0N: HRRZ A,-1(P) ;IS THE CHECKU ROUTINE ITSELF CALLING ME?
028 069 078 CAIL A,ENOINT ; DON'T WANT TO GET STUCK IN INFINITELY
029 198 032 JRST UINT0Q ; RECURSIVE CALLS.
030 069 004 CAIL A,NOINTERRUPT
031 059 035 JRST POPAJ
032 UINT0Q: PUSH FXP,F ;WELL, WE NEED TO RUN ANY DELAYED INTERRUPTS
033 015 026 SKIPE UNREAL
034 198 039 JRST UINT0Y
035 069 022 PUSHJ P,CHECKQ ;HACKISH ENTRY INTO CHECKU
036 UINT0V: POP FXP,F
037 059 035 JRST POPAJ
038
039 069 050 UINT0Y: PUSHJ P,CHECKZ ;HACKISH ENTRY INTO CHECKU
040 198 036 JRST UINT0V
041
042 015 026 UINT0Z: SKIPG UNREAL
043 059 035 JRST POPAJ
044 059 035 JUMPG A,POPAJ
045 198 027 JRST UINT0N
046
047 002 026 IFN ITS,[
048 197 038 UINT27: MOVE A,[LUINF,,P]
049 016 018 JSR PDLHAK
050 197 016 JRST UINT26
051
052 022 070 UINT43: MOVE A,[LSWS+6,,FXP]
053 016 018 JSR PDLHAK
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 198.1
054 197 019 JRST UINT42
055
056 UINT56: MOVE A,[4,,SP]
057 016 018 JSR PDLHAK
058 197 024 JRST UINT55
059 ] ;END OF IFN ITS
060
061 ] ;END OF IFE QIO
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 199
001
002 002 048 IFN QIO,[
003
004 ;;; SAVE THE WORLD FOR A USER INTERRUPT, INVOKE IT, AND RESTORE.
005 ;;;
006 ;;; SAVED QUANTITIES INCLUDE ALL ACCUMULATORS, THE PDL POINTERS
007 ;;; (FOR FRETURN), AND THE SUPER-WRITABLE STUFF (TEMPORARIES IN
008 ;;; LOW CORE USED BY INTERRUPTABLE FUNCTIONS).
009 ;;; MANY GLOBAL SWITCHES ARE BOUND AND RESET.
010 ;;; FOR ASYNCHRONOUS USER INTERRUPTS, THE (NOINTERRUPT T) STATE
011 ;;; MAY BE ENTERED; THE PREVIOUS NOINTERRUPT STATE IS SAVED.
012 ;;; MUST NOT COME HERE WITHOUT FIRST USING THE IWAIT
013 ;;; ROUTINE TO DECIDE WHETHER OR NOT WE ARE IN GC.
014 ;;; ALSO MUST CHECK THE NOINTERRUPT SWITCH BEFORE COMING HERE
015 ;;; IF THAT IS RELEVANT TO THE PARTICULAR USER INTERRUPT.
016 ;;; INTERRUPTS MUST BE TURNED OFF WITH PIOF BEFORE COMING HERE.
017 ;;; THE WORD DESCRIBING THE USER INTERRUPT MUST BE IN D.
018
019
020 015 019 YESINT: SKIPN NOQUIT
021 020 032 SKIPE INHIBIT
022 192 010 JRST YESIN1
023 181 057 UINT0: .SUSET [.SDF1,,TTYDF1] ;MUST ALLOW PDL OVERFLOW AND MEMORY
024 181 058 .SUSET [.SDF2,,TTYDF2] ; ERRORS TO GO THROUGH, BUT NO OTHERS
025 064 014 .SUSET [.SPICLR,,XC-1]
026 HRRZS (P) ;WILL HRROS IF ASYNCHRONOUS
027 060 036 PUSHJ P,SAVX5 ;SAVE NUMERIC ACS
028 015 026 PUSH FXP,UNREAL
029 BG$ PUSH FXP,BNV1
030 022 070 MOVSI R,-LSWS
031 020 013 PUSH FXP,SWS(R)
032 071 024 AOBJN R,.-1
033 048 005 JSP T,SPECBIND ;MUST SPECBIND LISAR
034 LISAR
035 020 031 SETZM PA4
036 021 055 IFN USELESS, SETZM TYOSW
037 020 032 SETZM INHIBIT
038 020 030 SETZM EOFRTN ;DO NOT SETZM CATRTN! GJS WANTS
039 020 035 SETZM BFPRDP ; TO THROW OUT OF USER INTERRUPTS
040 020 033 SETOM ERRSW
041 028 050 MOVE T,[-LINTPDL,,INTPDL] ;MUSTN'T CALL UINT0 FROM
042 028 050 CAME T,INTPDL ; WITHIN A PI SERVER
043 006 121 .LOSE
044 064 009 REPEAT 3, PUSH FXP,R70 ;RANDOM SLOTS FOR NUMERIC ARGS;
045 ; ; ALSO 4.9 OF TOP ONE => RETURN VALUE MATTERS
046 022 070 UIXPUSH==:5+1+BIGNUM+LSWS+3 ;AMOUNT OF STUFF PUSHED ON FXP
047 022 070 UISWS==:-<LSWS+3>+1 ;WHERE SWS STARTS WHEN SAVED ON FXP
048 199 047 UISAVT==:UISWS-6 ;WHERE ACCUMULATOR T GETS SAVED
049 061 007 PUSH P,[$UIFRAME] ;FRAME MARKER AND PDLS SAVED
050 PUSH P,FXP ; SO THAT THROW AND FRETURN WIN
051 058 003 HRLM FLP,(P) .SEE UIBRK
052 060 004 PUSHJ FXP,SAV5 ;SAVE ARGUMENT ACS AND 40 ON
053 PUSH P,40 ; REGPDL FOR GC PROTECTION
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 199.1
054 UIFRM==-2-NACS ;LOCATION OF FRAME ON REGPDL
055 199 054 UISAVA==UIFRM+2 ;LOCATION OF AC A ON REGPDL
056 199 054 MOVEI A,UIFRM(P)
057 020 046 MOVEM A,UIRTN
058 MOVSI AR2A,(CALLF 1,)
059 181 046 HLRZ A,D ;GET FIRST ARG FOR INTERRUPT FN
060 181 046 TRZN D,400000 ;DECODE INTERRUPT TYPE
061 200 004 JRST UINT30
062 181 046 HRRZM D,(FXP) ;TTY INPUT INTERRUPT CHAR
063 071 024 MOVEI R,(D)
064 MOVE TT,TTSAR(A)
065 189 009 JSP D,TTYICH ;FETCH INTERRUPT FN
066 MOVSI AR2A,(CALLF 2,)
067 071 024 HRRI AR2A,(R)
068 MOVEI B,(FXP) ;SECOND ARG IS CHARACTER
069 200 011 JRST UINT31
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 200
001
002 ;;; IFN QIO
003
004 181 046 UINT30: TRZN D,200000
005 200 014 JRST UINT32
006 181 046 MOVEI TT,(D) ;RANDOM FILE INTERRRUPT
007 ROT TT,-1
008 HRR AR2A,@TTSAR(A) ;FETCH INTERRUPT FUNCTION
009 SKIPL TT
010 HLR AR2A,@TTSAR(A)
011 199 054 UINT31: HRROS UIFRM-1(P) ;ASYNCHRONOUS INTERRUPT
012 200 029 JRST UINT40
013
014 181 046 UINT32: TRZN D,100000
015 200 025 JRST UINT33
016 HRRZM A,-1(FXP)
017 181 046 MOVEI A,QODDP(D) ;MACHINE ERROR
018 MOVEI B,(FXP)
019 035 006 MOVEI C,-1(FXP)
020 MOVEI AR1,-2(FXP)
021 MOVSI AR2A,(CALLF 4,)
022 HRR AR2A,VMERR
023 200 029 JRST UINT40
024
025 181 046 UINT33: LDB TT,[110200,,D] ;BITS 2.2-2.1 ARE CLASS
026 181 046 ANDI D,777 ;1.9-1.1 ARE SUBTYPE
027 200 083 XCT UINT90(TT) ;FETCH INTERRUPT FUNCTION
028 200 088 XCT UINT91(TT) ;SPECIAL HACKS
029 199 054 UINT40: SKIPGE UIFRM-1(P)
030 015 026 SETOM UNREAL
031 064 014 .SUSET [.SPICLR,,XC-1] ;***** ENABLE INTERRUPTS *****
032 064 009 .SUSET [.SDF1,,R70]
033 064 009 .SUSET [.SDF2,,R70]
034 209 025 XCT AR2A ;APPLY INTERRUPT FUNCTION
035 199 054 HRRZ T,UIFRM+1(P)
036 CAIE T,(FXP)
037 200 074 PUSHJ P,UINT45
038 199 054 HLRZ T,UIFRM+1(P)
039 CAIE T,(FLP)
040 200 075 PUSHJ P,UINT46
041 064 009 .SUSET [.SPICLR,,R70] ;***** DISABLE INTERRUPTS *****
042 SKIPGE (FXP) ;IF RETURN VALUE MATTERS
043 199 055 MOVEM A,UISAVA(P) ; SAVE IT FOR RETURN
044 049 033 PUSHJ P,UNBIND ;RESTORE LISAR, ETC.
045 199 047 UINT0X: HRLI R,UISWS(FXP)
046 020 013 HRRI R,SWS
047 020 013 BLT R,SWS+LSWS-1 ;RESTORE SUPER-WRITABLE STUFF
048 199 047 SUB FXP,[-UISWS+1,,-UISWS+1]
049 BG$ POP FXP,BNV1
050 POP P,40
051 060 021 PUSHJ FXP,RST5M1
052 POP P,-2(P) ;KNOCK OFF PDLS AND UIFRAME, SAVING
053 064 009 SUB P,R70+1 ; SAVED CONTENTS OF A FOR POPAJ BELOW
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 200.1
054 181 046 POP FXP,D ;OLD STATE OF UNREAL
055 SKIPL -1(P) ;IF INTERRUPT WASN'T ASYNCHRONOUS,
056 200 069 JRST UINT88 ; MUSTN'T ATTEMPT TO RESTORE UNREAL
057 015 026 EXCH D,UNREAL ;WELL, WE WANT TO RESTORE IT. WAS IT ON
058 200 069 JUMPE D,UINT88 ; JUST NOW? IF NOT, RETURN.
059 015 026 SKIPE A,UNREAL ;DID WE JUST TURN IT OFF BY RESTORING IT?
060 198 042 JRST UINT0Z ;NO, IT'S STILL ON - RETURN.
061 UINT0N: HRRZ T,-1(P) ;IS THE CHECKU ROUTINE ITSELF CALLING ME?
062 069 078 CAIGE T,ENOINT ; DON'T WANT TO GET STUCK IN INFINITELY
063 069 004 CAIGE T,NOINTERRUPT ; RECURSIVE CALLS
064 069 022 PUSHJ P,CHECKQ ;HACKISH ENTRY INTO CHECKU
065 200 069 JRST UINT88
066
067 015 026 UINT0Z: SKIPLE UNREAL
068 198 027 JUMPLE D,UINT0N
069 060 046 UINT88: PUSHJ P,RSTX5
070 064 014 .SUSET [.SPICLR,,XC-1] ;RE-ENABLE INTERRUPTS
071 059 035 JRST POPAJ
072 Q$ EUINT0:: .SEE PDLOV ;END OF UINT0
073
074 UINT45: SKIPA B,[QFIXNUM]
075 UINT46: MOVEI B,QFLONUM
076 EXCH A,B
077 200 081 PUSHJ P,UINT49
078 EXCH A,B
079 POPJ P,
080
081 022 059 UINT49: FAC [PDL OUT OF PHASE IN USER INTERRUPT (SYSTEM ERROR)!]
082
083 181 046 UINT90: HRR AR2A,VALARMCLOCK(D) ;ALARMCLOCK SERIES
084 181 046 HRR AR2A,VAUTFN(D) ;RANDOM SYNCHRONOUS
085 181 046 HRR AR2A,VUDF(D) ;ERINT SERIES
086 .VALUE ;??
087
088 199 054 UINT91: HRROS UIFRM-1(P) ;ALARMCLOCK (ASYNCHRONOUS)
089 JFCL ;RANDOM SYNCHRONOUS
090 SETOM (FXP) ;ERINT (VALUE MATTERS)
091 .VALUE ;??
092 ] ;END OF IFN QIO
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 201
001
002 181 046 CKI0: PUSH FXP,D
003 015 012 HRRZ D,INTFLG
004 181 046 CAIN D,-1
005 201 069 JRST CKI1 ;DELAYED USER INTERRUPT
006 Q% PIOF
007 064 009 Q$ .SUSET [.SPICLR,,R70]
008 028 023 CKI2: SETZM UNREAR
009 028 018 CKI2A: SETZM UNRC.G ;CHECKU JOINS IN AT THIS POINT
010 015 012 SETZM INTFLG ; RESET TTY NO RESET
011 181 046 TRNE D,4 ;↑X -6 -2
012 201 036 JRST CKI3 ;↑G -7 -3
013 002 026 IFN ITS,[
014 010 009 Q% .RESET TYIC,
015 010 010 Q% .RESET TYOC,
016 002 048 IFN QIO,[
017 181 046 PUSH FXP,D
018 017 016 MOVEI F,LCHNTB-1 ;RESET ALL TTY FILES
019 017 019 CKI2F: SKIPN AR1,CHNTB(F)
020 201 028 JRST CKI2F1
021 MOVE TT,TTSAR(AR1)
022 TLNN TT,TTS.TY
023 201 028 JRST CKI2F1
024 MOVEI T,CLRI3
025 TLNE TT,TTS.IO
026 MOVEI T,CLRO3
027 PUSHJ FXP,(T)
028 201 019 CKI2F1: SOJG F,CKI2F
029 181 046 POP FXP,D
030 ] ;END OF IFN QIO
031 ] ;END OF IFN ITS
032 10$ CLRBFO
033 10$ CLRBFI
034 032 006 Q% SETZM PBFTY
035 Q% SETZM RDTYBF
036 CKI3:
037 002 026 IFN ITS,[
038 002 048 IFE QIO,[
039 .SUSET [.RDF1,,A]
040 201 045 JUMPE A,CKI3B
041 .SUSET [.SAMASK,,A]
042 064 009 .SUSET [.SDF1,,R70]
043 ] ;END OF IFE QIO
044 ] ;END OF IFN ITS
045 181 046 CKI3B: TRNN D,2
046 032 032 SKIPE PSYMF
047 114 002 RQITR: LERR [SIXBIT \QUIT!\] ;SO ERROR OUT FOR ↑X
048 027 061 MOVE P,C2 ;DRASTIC ACTION FOR ↑G
049 MOVE A,VERRLIST
050 MOVEM A,VIQUOTIENT
051 046 054 JSP A,ERINI0
052 002 026 IFN QIO*USELESS*ITS,[
053 015 046 MOVE T,IMASK
USER INTERRUPT ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 201.1
054 TRNN T,%PIMAR
055 201 058 JRST CKI4A
056 020 056 .SUSET [.RMARA,,SAVMAR]
057 064 009 .SUSET [.SMARA,,R70] ;AVOID TRIPPING THE MAR DURING THE ERRPOP
058 CKI4A:
059 ] ;END OF IFN QIO*USELESS*ITS
060 049 002 PUSHJ P,ERRPOP
061 002 026 IFN QIO*USELESS*ITS,[
062 TRNE T,%PIMAR ;ERRPOP PRESERVES T
063 020 056 .SUSET [.SMARA,,SAVMAR]
064 ] ;END OF IFN QIO*USELESS*ITS
065 SETZM TTYOFF
066 201 047 STRT 17,@RQITR
067 040 027 JRST LSPRT1 ;WILL PION WITHIN ERINIT
068
069 CKI1:
070 181 046 Q% POP FXP,D ;RETURN TO SERVICE THE DELAYED INTERRUPT
071 020 032 SKIPE INHIBIT ;BUT NO SERVICE WHEN INHIBIT = -1
072 Q% POPJ P,
073 059 057 Q$ JRST POPXDJ
074 196 042 PUSHJ P,UINTPU
075 015 012 SETZM INTFLG
076 PUSH P,A
077 PUSH P,A
078 020 032 HLLOS INHIBIT
079 028 010 SKIPG A,INTAR
080 LERR EMS13 ;LOST USER INTERRUPT
081 CKI1A:
082 028 010 Q% MOVS A,INTAR(A)
083 Q% MOVSM A,(P) ;FOR GC PROTECTION
084 028 010 Q$ MOVS D,INTAR(A)
085 181 046 Q$ MOVSM D,(P)
086 028 010 SOS INTAR ;CYCLE THROUGH THE DELAYED INTERRUPTS
087 197 011 PUSHJ P,UINT0
088 028 010 SKIPLE A,INTAR
089 201 081 JRST CKI1A
090 064 009 SUB P,R70+1
091 POP P,A
092 015 012 SETZM INTFLG
093 020 032 SETZM INHIBIT
094 196 017 Q% JRST UINTEX
095 196 017 Q$ PUSHJ P,UINTEX
096 059 057 Q$ JRST POPXDJ
097
098 002 048 IFN QIO,[
099 131 052 CKI2I: SETZ ;EVENTUALLY FLUSH THIS
100 SIXBIT \RESET\
101 018 019 400000,,TTYIF2+F.CHAN
102 ] ;END OF IFN QIO
OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 202
001
002 002 048 IFE QIO,[
003
004 SUBTTL OLD I/O CONTROL CHARACTER ROUTINES
005
006 ;CNTROL: 0
007 CNTRL1: CAIG A,36 ;NO INTERRUPT CHAR USABLE WITH ASCII > 036
008 202 017 XCT CNTBL(A)
009 016 014 JRST 2,@CNTROL
010 HRLI A,TRUTH ;SKIPS => WANTS T IN VALUE CELL
011 202 017 HLRZM A,@CNTBL(A)
012 016 014 JRST 2,@CNTROL
013
014
015 ;;; ********** TABLE OF CONTROL CHAR ACTIONS **********
016
017 204 014 CNTBL: JRST CN.AT ;↑@
018 204 004 JRST CN.A ;↑A
019 IT$ SKIPA LPTON ;↑B
020 10$ JFCL ;↑B
021 SETZM GCGAGV ;↑C
022 SKIPA GCGAGV ;↑D
023 203 005 IFE D10, JRST CN.E ;↑E
024 005 005 IFN D10, JFCL
025 209 011 IFN MOBIOF, JRST CN.F ;↑F
026 002 039 IFE MOBIOF, JFCL
027 189 050 JRST CN.G ;↑G
028 204 010 JRST CN.H ;↑H
029 JFCL ;UNUSED CONTROL CHARACTERS, ETC.
030 REPEAT 4, JFCL ;↑J-↑M
031 002 039 IFN MOBIOF,[
032 SKIPA DISPON ;↑N
033 203 012 JRST CN.O ;↑O
034 ] ;END OF IFN MOBIOF
035 002 039 IFE MOBIOF, REPEAT 2, JFCL
036 JFCL ;↑P
037 SKIPA TAPRED ;↑Q
038 SKIPA TAPWRT ;↑R
039 SETZM TAPRED ;↑S
040 SETZM TAPWRT ;↑T
041 030 038 SETOM PAUSFL ;↑U
042 SETZM TTYOFF ;↑V
043 189 024 JRST CN.W
044 189 049 JRST CN.X ;↑X
045 209 011 IFN MOBIOF, JRST CN.Y ;↑Y
046 002 039 IFE MOBIOF, JFCL
047 177 054 JRST CN.Z ;↑Z
048 JFCL ;ALT-MODE NOT MADE INTERRUPT CHAR
049 204 007 JRST CN.34 ;↑\
050 204 007 JRST CN.34 ;[ ;↑]
051 204 007 JRST CN.34 ;↑↑
052 202 017 IFN .-CNTBL-37, WARN [CNTBL LOSSAGE]
053
OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 203
001
002 ;;; IFE QIO,
003
004 002 026 IFN ITS,[
005 010 013 CN.E: .CLOSE LPTC,
006 SETZM LPTON
007 SETZM LPTOPD
008 016 014 JRST 2,@CNTROL
009 ] ;END OF IFN ITS
010
011 002 039 IFN MOBIOF,[
012 016 038 CN.O: JSR CLZDIS
013 016 014 JRST 2,@CNTROL
014 ] ;END OF IFN MOBIOF
015
016 CN.W: HRLI A,TRUTH
017 HLRZM A,TTYOFF
018 010 010 IT$ .RESET TYOC, ;RESET TTY OUTPUT CHANNEL
019 10$ CLRBFO
020 004 046 10X WARN [TTY OUTPUT CLEAR IN TENEX]
021 016 014 JRST 2,@CNTROL
022
023
024 CTRLG: PIOF ;↑G - SUBR 0
025 MOVE A,[-3,,-3]
026 203 030 JRST CN.G0
027
028 CN.X: SKIPA A,[-6,,-2] ;ERRSETABLE (↑X) QUIT
029 CN.G: MOVE A,[-7,,-3] ;IMMEDIATE (↑G) QUIT
030 015 026 CN.G0: SKIPE UNREAL
031 189 061 JRST CN.G1
032 028 010 SETZM INTAR ;KILL ALL INTERRUPTS STACKED UP
033 015 012 HRREM A,INTFLG
034 016 014 HRR A,CNTROL ;IF CALL CAME FROM IOC, THEN DONT
035 129 017 TRC A,IOC2 ;WANT TO DO A RESET ON THE TYI CHANNEL
036 TRNE A,-1
037 015 012 CN.G2: HLREM A,INTFLG
038 016 008 JSR INTWAIT
039 066 021 PUSHJ P,CHECKI
040 016 014 JRST 2,@CNTROL
041
042 028 023 CN.G1: SETZM UNREAR
043 015 031 MOVEM R,QITR
044 016 014 HRRZ R,CNTROL
045 CAME A,[-3,,-3]
046 129 017 CAIN R,IOC2
047 203 054 JRST CN.G3
048 028 018 MOVE R,UNRC.G
049 064 014 CAME R,XC-3
050 028 018 HRREM A,UNRC.G
051 015 031 MOVE R,QITR
052 016 014 JRST 2,@CNTROL
053
OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 203.1
054 015 031 CN.G3: MOVE R,QITR
055 203 037 JRST CN.G2
OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 204
001
002 ;;; IFE QIO
003
004 CN.A: HRLI A,TRUTH
005 HLRZM A,SIGNAL
006 TLZA A,-1 ;WHEN ↑A HAPPENS, AC A HAS 1 IN IT, AND ↑A INT NO. IS 2
007 CN.34: SUBI A,34-14.+1 ;CNTRL KEYS 34-36 ARE INT NOS. 14. TO 16.
008 204 013 AOJA A,UINT1
009
010 Q% CN.H: ;CONTROL-H BREAK
011 Q$ CN.B: ;CONTROL-B BREAK
012 MOVEI A,1 ;CURRENTLY, ALL CONTROL-KEY INTERRUPTS HAVE NIL AS ARG
013 UINT1:
014 CN.AT: SKIPN @UINTTB(A) ;FOR ↑@, A MUST HAVE HAD ZERO IN IT
015 016 014 JRST 2,@CNTROL
016 015 026 SKIPE UNREAL
017 204 031 JRST UINT1Q
018 030 038 Q% SETOM PAUSFL
019 016 008 UINT1R: JSR INTWAIT
020 204 024 JRST UINT1A ;NO SKIP MEANS RUNNING INTERRUPT NOW IS OK
021 016 014 INTW3: JRST 2,@CNTROL ;OTHERWISE, A USER PI HAS BEEN STACKED UP
022 ;[UNLESS THERE IS A QUIT SIGNAL PENDING]
023
024 016 014 UINT1A: PUSH P,CNTROL
025 020 015 IT$ PUSH P,INT ;INT CONTAINS WHAT WAS IN A UPON ENTRY
026 059 041 IT$ PUSH P,CPOP1J ;TO INTERRUPT - THUS IS NOW GC PROTECTED
027 179 038 10$ PUSHJ P,UPCHK
028 002 030 10X WARN [TENEX USER INTERRUPT]
029 196 007 JRST UINT
030
031 015 031 UINT1Q: MOVEM R,QITR
032 071 024 MOVEI R,(A)
033 071 024 CAIN R,3 ;ALARMCLOCK
034 204 053 JRST UINT1S
035 016 014 Q% HRRZ R,CNTROL
036 129 017 Q% CAIN R,IOC2
037 204 053 Q% JRST UINT1S
038 015 030 MOVEM D,QITD
039 028 023 AOS R,UNREAR
040 028 015 CAIG R,LUNREAR
041 204 047 JRST UINT1U
042 028 023 SOS UNREAR
043 LERR EMS12 ;TOO MANY INTERRUPTIONS
044
045 028 023 UINT1T: MOVE D,UNREAR(R)
046 028 023 MOVEM D,UNREAR+1(R)
047 204 045 UINT1U: SOJG R,UINT1T
048 028 023 MOVEM A,UNREAR+1
049 015 030 MOVE D,QITD
050 015 031 MOVE R,QITR
051 016 014 JRST 2,@CNTROL
052
053 015 031 UINT1S: MOVE R,QITR
OLD I/O CONTROL CHARACTER ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 204.1
054 204 019 JRST UINT1R
055
056
057 ] ;END OF IFE QIO
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 205
001
002
003 SUBTTL UUOH HANDLER (INCLUDING STRT)
004
005 ;UUOH: 0 ;UUO HANDLER
006 022 063 UUOH0: MOVEM T,UUTSV
007 LDB T,[331100,,40]
008 CAIL T,CALL←-33
009 206 004 JRST UUOH0B ;PROBABLY A LISP "CALL" UUO
010 UUOH2: CAILE T,UUOMAX
011 131 052 SETZ T,
012 205 013 JRST @UUOH2A(T)
013 UUOH2A: ERRBAD ;0 IS ILGL, ILGL, ILGL
014 ERROR1 ;LERR ;UNCORRECTABLE LISP ERROR
015 205 028 UUOACL ;ACALL ;KLUDGE FOR NCALLING ARRAYS
016 205 030 UUOAJC ;AJCALL ;JRST VERSION OF ACALL
017 ERROR1 ;LER3 ;LERR, BUT ALSO PRINT ACCUMULATOR A
018 ERROR5 ;ERINT ;CORRECTABLE ERROR WITH SIXBIT MSG
019 144 018 POF1 ;PP Z$X ;PRINT OUT Z FROM DDT
020 219 003 STRTOUT ;STRT ;SIXBIT STRING TYPE OUT
021 ERROR5 ;SERINT ;CORRECTABLE ERROR WITH S-EXP MSG
022 144 017 TOF1 ;TP Z$X ;TYPEP PRINTOUT OF Z FROM DDT
023 205 024 ERRIOJ ;IOJRST ;HAIRY FROB TO GET I/O ERROR MSGS
024 Q% ERRIOJ==:ERRBAD ;IOJRST IS FOR NEWIO ONLY
025 205 013 IFN .-UUOH2A-1-UUOMAX, WARN [UUOH2A OUT OF PHASE]
026
027
028 022 058 UUOACL: PUSH P,UUOH
029 BAKPRO
030 UUOAJC: MOVE T,@40 .SEE ASAR
031 TLNE T,AS<FX+FL>
032 AOJA T,.+2 ;FOR NUMBER ARRAYS, ENTER AT HEADER+1
033 210 041 PUSH P,[UUONVL] ;FOR OTHER ARRAYS, USE NUMVAL CHECK ROUTINE
034 XCTPRO
035 022 063 EXCH T,UUTSV
036 226 027 SPECPRO INTACT
037 022 063 JRST @UUTSV
038 NOPRO
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 206
001
002 ;;; DISPATCH ON "CALL" TYPE UUO, TRAPPING TO INTERPRETER IF NECESSARY
003
004 UUOH0B: CAILE T,NJCALF←-33
005 205 010 JRST UUOH2
006 022 064 MOVEM TT,UUTTSV
007 022 065 MOVEM R,UURSV
008 LDB TT,[270400,,40]
009 CAIG TT,15 ;LISP "CALL" TYPE UUOS
010 071 024 TDZA R,R
011 071 024 MOVEI R,-15(TT)
012 HRRZ T,40
013 022 062 UUOH0A: MOVEM T,UUOFN
014 TLZ T,-1
015 MOVEI TT,(T)
016 005 042 LSH TT,-SEGLOG
017 036 033 SKIPGE TT,ST(TT)
018 207 033 JRST @UUNAF(R)
019 TLNN TT,SY
020 206 031 JRST UUOH0C
021 071 024 TLZ R,700000 ;400000 => AUTOLOAD, 200000 => MACRO, 100000 => ALREADY DID AUTOLOAD
022 UUOH1: HRRZ T,(T)
023 206 040 JUMPE T,UUOH1A
024 HLRZ TT,(T)
025 HRRZ T,(T)
026 CAIL TT,QARRAY
027 CAILE TT,QAUTOLOAD
028 206 022 JRST UUOH1
029 207 004 2DIF JRST @(TT),UUOTRT,QARRAY
030
031 UUOH0C: TLNN TT,SA
032 209 011 JRST UUOH3A
033 HRRZ TT,ASAR(T) ;HANDLE CASE OF A SAR EFFICIENTLY
034 CAIN TT,ADEAD
035 209 011 JRST UUOH3A
036 MOVSI T,(T)
037 HRRI T,T
038 207 015 JRST @UUAT(R)
039
040 207 043 UUOH1A: JUMPL R,UUALT1
041 071 024 TLNE R,200000
042 209 011 JRST UUOMER
043 PUSH P,A
044 PUSH P,B
045 022 062 SKIPGE A,UUOFN
046 209 011 JRST UUOUER
047 HLRZ T,(A)
048 HRRO T,@(T)
049 UUOH3B: POP P,B
050 POP P,A
051 CAIE T,QUNBOUND
052 206 013 JRST UUOH0A
053 209 011 JRST UUOH3A
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 207
001
002 ;;UUO TRANSFER TABLE, ONCE FUNCTION TYPE IS KNOWN
003
004 UUOTRT:
005 IRPS LL,X,[A+S+FS+L+E+FE+MC-AL-]
006 071 024 IFSE X,+, @UU!LL!T(R)
007 IFSE X,-, UU!LL!T
008 TERMIN
009
010 ;;; MOBY DISPATCH TABLE FOR DECODING UUO CALL TYPES!
011 ;;; R=0 => COMPILED ROUTINE CALLING A SUBR TYPE
012 ;;; R=1 => COMPILED ROUTINE CALLING A LSUBR TYPE
013 ;;; R=2 => COMPILED ROUTINE CALLING A FSUBR TYPE
014
015 210 002 UUAT: UUOARR ;CALLING SUBR - IT'S AN ARRAY **WIN**
016 214 030 UUOS1A ;CALLING LSUBR - IT'S AN ARRAY
017 214 003 UUOS2A ;CALLING FSUBR - IT'S AN ARRAY
018 210 006 UUST: UUOS0 ;CALLING SUBR - IT'S A SUBR **WIN**
019 211 025 UUOS1 ;CALLING LSUBR - IT'S A SUBR
020 214 009 UUOS2 ;CALLING FSUBR - IT'S A SUBR
021 216 033 UUFST: UUOS10 ;CALLING SUBR - IT'S AN FSUBR
022 215 033 UUOS11 ;CALLING LSUBR - IT'S AN FSUBR
023 209 003 UUOSBR ;CALLING FSUBR - IT'S AN FSUBR **WIN**
024 213 003 UULT: UUOS7 ;CALLING SUBR - IT'S AN LSUBR
025 212 008 UUOLSB ;CALLING LSUBR - IT'S AN LSUBR **WIN**
026 213 002 UUOS9 ;CALLING FSUBR - IT'S AN LSUBR
027 216 009 UUET: UUOEXP ;CALLING SUBR - IT'S AN EXPR
028 217 003 UUOS5 ;CALLING LSUBR - IT'S AN EXPR
029 215 009 UUOS6 ;CALLING FSUBR - IT'S AN EXPR
030 216 003 UUFET: UUOS3 ;CALLING SUBR - IT'S A FEXPR
031 215 004 UUOS4 ;CALLING LSUBR - IT'S A FEXPR
032 216 005 UUOEX2 ;CALLING FSUBR - IT'S A FEXPR
033 216 008 UUNAF: UUOS ;CALLING SUBR - IT'S A NONATOMICFUN
034 217 002 UUL2N ;CALLING LSUBR - IT'S A NONATOMICFUN
035 215 008 UUF2N ;CALLING FSUBR - IT'S A NONATOMICFUN
036
037
038 022 066 UUALT: HRRZM T,UUALT9 ;FOUND AN AUTOLOAD PROPERTY
039 071 024 TLOA R,400000
040 071 024 UUMCT: TLO R,200000 ;MACROS ARE IGNORED, SORT OF
041 206 022 JRST UUOH1
042
043 071 024 UUALT1: TLOE R,100000 ;CALLING ANYTHING - IT'S AN AUTOLOAD
044 209 011 JRST UUOH3C ;LOSE IF JUST DID AN AUTOLOAD ALREADY
045 PUSH P,A
046 022 066 HLRZ A,@UUALT9 ;OTHERWISE AUTOLOAD THE FUNCTION
047 022 062 MOVE T,UUOFN
048 129 031 PUSHJ P,AUTOLOAD ;BETTER SAVE R, BY GEORGE!
049 POP P,A
050 022 062 MOVE T,UUOFN
051 206 022 JRST UUOH1 ;NOW TRY IT AGAIN
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 208
001
002
003 ;;; MAY CALL UUOBNC AND UUOBAK ONLY WHEN *RSET IS KNOWN
004 ;;; TO BE NON-NIL - AVOIDS CERTAIN TIMING ERRORS.
005
006 022 068 UUOBNC: POP P,UUOBKG ;UUOBKG WITH NO CPOPJ
007 022 068 HRROS UUOBKG ;FOR UUO GUYS THAT CALL IAPPLY,
008 208 017 JRST UUOBK0 ; WHICH ITSELF SETS UP A CPOPJ
009
010 022 068 UUOBAK: POP P,UUOBKG ;WATCH THIS CROCK!
011 208 016 JRST UUOBK7
012
013 ;;;UUOBKG: 0
014 UUBKG1: SKIPN V.RSET ;CHECK TO SEE WHETHER IN *RSET MODE
015 022 068 JRST @UUOBKG ;SAVES ALL ACS; T HAS -<# OF ARGS>
016 022 068 UUOBK7: HRRZS UUOBKG
017 UUOBK0: SKIPE NIL
018 043 024 PUSHJ P,NILBAD
019 PUSH FXP,TT ;PDLS MUST BE AS FRETURN WOULD WANT
020 071 024 PUSH FXP,R ; TO RESTORE THEM TO
021 208 028 JUMPGE T,UUOBK1 ;IF T>0, THEN ASSUME 0, AND THE
022 218 040 JSP TT,ARGP0 ; ARGS WILL BE FILLED IN LATER
023 MOVNI TT,(T)
024 SKIPGE A
025 131 052 SETZ TT,
026 HRLM TT,(P)
027 208 029 JRST UUOBK8
028 064 009 UUOBK1: PUSH P,R70
029 UUOBK8: MOVEI TT,-2(FXP)
030 HRLI TT,(FLP)
031 PUSH P,TT
032 HRRZ TT,40
033 HRLI TT,(SP)
034 PUSH P,TT
035 208 038 JUMPLE T,UUOBK5
036 064 009 PUSH P,R70
037 208 039 JRST UUOBK6
038 061 044 UUOBK5: PUSH P,[$APPLYFRAME]
039 071 024 UUOBK6: MOVS R,40
040 059 031 HRRI R,CPOPJ
041 022 068 SKIPL UUOBKG ;MAYBE DON'T WANT THE CPOPJ
042 071 024 PUSH P,R
043 022 068 HRRZS UUOBKG
044 071 024 POP FXP,R
045 POP FXP,TT
046 022 068 JRST @UUOBKG
047
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 209
001
002
003 UUOSBR: HLRZ T,(T) ;*** FSUBR CALLED LIKE FSUBR
004 022 067 MOVEM P,UUPSV
005 071 024 MOVNI R,1
006 TLOA A,400000
007 071 024 UUOSB2: MOVEI R,1 ;R>0 SAYS DON'T DO FRAME HACKERY
008 UUOSB3: MOVE TT,40 ;OTHERWISE R HAS -<# OF ARGS>
009 UUOSB5: TLO T,(PUSHJ P,)
010 TLNE TT,(1←33) ;THE NO-PUSH, OR JRST, BIT. SEE DEFINITION OF JCALL
011 209 011 TLCA T,(JRST#<PUSHJ P,>)
012 022 058 PUSH P,UUOH
013 209 017 UUOSB6: JUMPG R,UUOSB7
014 071 024 EXCH T,R
015 022 068 JSR UUOBKG
016 071 024 EXCH T,R
017 UUOSB7: TLZ A,-1
018 TLNE TT,(20←33) ;THE NUMERIC CALL BIT. SEE DEFINITION OF NCALL
019 AOS T ;FOR NCALL, ENTER AT ENTRY+1
020 SKIPN VNOUUO
021 TLNE TT,(2←33) ;THE NO-CLOBBER BIT. SEE DEFINITION OF CALLF
022 209 028 JRST UUOXT0
023 022 058 SOS TT,UUOH
024 071 024 UUOSB4: LDB R,[331100,,(TT)]
025 071 024 CAIN R,XCT←-33
026 209 035 JRST UUOXCT ;MAKE XCT OF UUO WORK
027 MOVEM T,(TT)
028 UUOXT0: TLNN T,(34←33) ;CAUSE EXIT TO INDIRECT THRU ACALL
029 TLO T,(@)
030 022 063 UUOXIT: EXCH T,UUTSV
031 022 064 UUOXT1: MOVE TT,UUTTSV
032 022 065 MOVE R,UURSV
033 022 063 JRST @UUTSV
034
035 071 024 UUOXCT: LDB R,[220400,,(TT)] ;GET INDEX FIELD OF XCT
036 071 024 JUMPE R,.+2
037 209 046 HRRZ R,@UUOACS-1(R) ;IF NON-ZERO, GET CONTENTS OF THAT AC
038 071 024 ADD R,(TT) ;ADD IN ADDRESS FIELD
039 071 024 HLL R,(TT)
040 071 024 MOVEI TT,(R)
041 071 024 TLNE R,(@)
042 209 035 JRST UUOXCT ;MAKE INDIRECTION WIN
043 209 024 JRST UUOSB4 ;MAKE XCT OF XCT ... OF XCT OF UUO WIN
044
045 ;;; TABLE OF WHERE TO FIND THE ACS AS THEY WERE ON UUO ENTRY
046 UUOACS:
047 022 067 IRPS X,,[A B C AR1 AR2A UUTSV UUTTSV D UURSV F FREEAC UUPSV FLP FXP SP]
048 X
049 TERMIN
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 210
001
002 071 024 UUOARR: HLRZ R,(T) ;*** ARRAY CALLED LIKE SUBR
003 MOVSI TT,(@)
004 210 008 JRST UUOS03
005
006 131 052 UUOS0: SETZ TT, ;*** SUBR CALLED LIKE SUBR
007 022 062 HRRZ R,UUOFN
008 022 067 UUOS03: MOVEM P,UUPSV ;THIS IS TO HELP UUOXCT
009 HLR TT,(T)
010 PUSH P,TT
011 LDB T,[270400,,40]
012 MOVNS T
013 PUSH FXP,T
014 218 003 PUSHJ P,ARGCHK ;SKIPS IF OK
015 211 002 JRST UUOS0E
016 071 024 POP FXP,R ;R NOW HAS -<# OF ARGS>
017 POP P,T
018 TLNN T,(@) ;FURTHER WORK NEEDED FOR CALLING AN ARRAY
019 209 008 JRST UUOSB3
020 MOVSI TT,TTS<CN>
021 HLL A,40 ;UUOSB7 WILL CLEAR LEFT HALF OF A
022 TLNN A,2000 ;DO NOT SET THE COMPILED-CODE-
023 IORM TT,TTSAR(T) ; NEEDS-ME BIT FOR A CALLF!
024 MOVE TT,40
025 TLZN TT,(20←33)
026 209 008 JRST UUOSB3
027 TLNN TT,(2←33)
028 210 033 JRST UUOAR2 ;NCALL'ING AN ARRAY MEANS CLOBBER,
029 210 041 PUSH P,[UUONVL] ; IF ANY, SHOULD BE TO ACALL
030 209 009 JRST UUOSB5
031
032
033 UUOAR2: TLNN TT,1000
034 TLOA T,(ACALL) ;NCALL, BUT NOT NCALLF => ACALL
035 TLOA T,(AJCALL) ;NJCALL, BUT NOT NJCALF => AJCALL
036 022 058 PUSH P,UUOH
037 TLZ TT,777000
038 TLZ T,(@)
039 209 013 JRST UUOSB6
040
041 UUONVL: SKOTT A,FX+FL
042 209 011 JRST UUONVE
043 FIX7: MOVE TT,(A) ;OF COURSE, THE ROUTINE HAD BETTER COME UP
044 POPJ P, ;WITH SOME LISP NUMBER AS VALUE
045
046 181 046 UUOS1E: PUSH FXP,D
047 181 046 MOVEI D,1
048 210 051 JRST UUOE3
049 181 046 UUOS2E: MOVEM D,(FXP) ;TAKE THE SPOT ALREADY PUSHED ON FXP
050 181 046 MOVEI D,3
051 060 041 UUOE3: PUSHJ P,SAVX3 ;ARGS WERE ALREADY ON PDL, HENCE MUST BE POPPED OFF
052 MOVEM B,QF1SB ;SO WE MIGHT AS WELL LIST THEM UP WHILE WE'RE AT IT
053 PUSH FXP,T
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 210.1
054 068 020 PUSHJ FXP,LISTX
055 POP FXP,T
056 MOVE B,QF1SB
057 211 006 JRST UUOE2
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 211
001
002 064 009 UUOS0E: SUB P,R70+1
003 181 046 UUOS0F: PUSH FXP,D
004 060 041 PUSHJ P,SAVX3
005 181 046 MOVEI D,0
006 181 046 UUOE2: TLNE D,2 ;D 1.2 => EXIT ADDRESS ALREADY BEEN HACKED
007 209 011 JRST .+4
008 071 024 MOVE R,40
009 071 024 TLNN R,1000
010 022 058 PUSH P,UUOH
011 060 005 PUSHJ FXP,SAV5M1
012 211 021 PUSH P,[UUOSE1]
013 MOVE TT,40
014 HRLS TT
015 PUSH P,TT ;NAME OF FUNCTION IN LH
016 181 046 TRNN D,1 ;1.1 => LISTING HAS ALREADY BEEN DONE
017 218 040 JSP TT,ARGP0 ;ARGS TO FUNCTION NOW ON PDL
018 181 046 MOVEM D,-1(FXP)
019 060 053 PUSHJ P,RSTX3 ;RECUPERATE - IF POSSIBLE, DO NEW EVALUATION
020 209 011 JRST WNAERR ;OR ELSE CRAP OUT ON WRONG NUMBER ARGS
021 060 021 UUOSE1: PUSHJ FXP,RST5M1
022 181 046 POP FXP,D
023 POPJ P,
024
025 UUOS1: HRRZ TT,(T) ;*** SUBR CALLED LIKE LSUBR
026 HLRZ T,(T)
027 022 063 EXCH T,UUTSV
028 218 046 JSP R,PDLARG
029 022 062 HRRZ R,UUOFN
030 218 012 PUSHJ P,ARGCK0 ;FORCE CHECKING OF NUMBER OF ARGS
031 211 003 JRST UUOS0F
032 MOVE TT,40
033 TLNE TT,(20←33) ;THE NCALL BIT
034 022 063 AOS UUTSV
035 TLNN TT,(1←33) ;THE NO-PUSH, OR JRST, BIT. SEE DEFINITION OF JCALL
036 022 058 PUSH P,UUOH
037 022 068 JSR UUOBKG
038 209 031 JRST UUOXT1
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 212
001
002 022 058 UUOX4B: SKIPN UUOH ;=0 MEANS ENTRY FROM MAP SERIES
003 209 011 JRST (R)
004 060 005 PUSHJ FXP,SAV5M1
005 060 025 PUSH P,CR5M1PJ
006 209 011 JRST (R)
007
008 022 067 UUOLSB: MOVEM P,UUPSV ;*** LSUBR CALLED LIKE LSUBR
009 MOVEI A,NIL
010 HLRZ T,(T)
011 SKIPN V.RSET
012 209 007 JRST UUOSB2
013 PUSH FXP,T ;SAVE T (ADDRESS OF LSUBR)
014 022 063 MOVE T,UUTSV
015 PUSH FXP,T ;SAVE -<# OF ARGS> FOR UUOFUL
016 022 062 HRRZ R,UUOFN ;FOR ARGCK0
017 218 012 PUSHJ P,ARGCK0
018 210 046 JRST UUOS1E
019 071 024 MOVE R,T ;WATCH THIS SHUFFLING OF R, T, AND UUTSV!
020 066 009 JSP T,NPUSH-6 ;SIX SLOTS FOR "APPLY FRAME", ETC.
021 022 063 MOVE T,UUTSV
022 022 063 MOVEM R,UUTSV
023 MOVEI T,(P)
024 212 028 UUOLB3: AOJG R,UUOLB4 ;SO SLIDE STUFF SIX SLOTS UP THE PDL
025 MOVE TT,-6(T) ;AT END, T POINTS TO LAST OF THE FIVE
026 MOVEM TT,(T) ; FRAME SLOTS FOR UUOFUL
027 212 024 SOJA T,UUOLB3
028 UUOLB4: MOVE TT,40 ;FIGURE OUT IF CALL OR CALLF TYPE
029 059 031 MOVEI R,CPOPJ ; (MAY BE CALL TYPE IF 0 ARGS)
030 071 024 TLO R,(PUSHJ P,) ;FIGURE IT OUT
031 TLNE TT,1000 ;IT MAY LOOK LIKE WE'RE CONSTRUCTING A PUSHJ
032 209 011 TLCA R,(JRST#<PUSHJ P,>) ; TO THE WRONG PLACE, BUT READ THIS CAREFULLY!
033 022 058 HRR R,UUOH ;RETURN ADDRESS MUST GO UNDER
034 071 024 HRRZM R,-5(T) ; THE FRAME, NOT OVER!!!
035 071 024 HLLM R,-1(FXP) ;SAVE INSTRUCTION TO CLOBBER WITH
036 MOVEI TT,(T)
037 212 045 PUSHJ P,UUOFUL ;SO STICK AN APPLY FRAME UNDER ARGS, IF ANY
038 ;REMEMBER, UUOFUL EXPECTS TWO FROBS
039 ; ON FXP, AND POPS ONE OF THEM
040 POP FXP,T ;RESTORE T (ADDRESS OF LSUBR)
041 MOVE TT,40
042 209 017 JRST UUOSB7
043
044
045 071 024 UUOFUL: MOVS R,40 ;PUT FRAME UNDER LSUBR CALL
046 059 031 HRRI R,CPOPJ ;TT POINTS TO LAST OF 5 PDL SLOTS
047 071 024 MOVEM R,(TT) ;USES T,TT,R
048 071 024 MOVEI R,-2(FXP) ;FXP HAS -<# OF ARGS> AND ONE
049 071 024 HRRM R,-3(TT) ; OTHER SLOT AS WELL
050 HRLM FLP,-3(TT)
051 HRLM SP,-2(TT)
052 071 024 HRRZ R,40
053 071 024 HRRM R,-2(TT)
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 212.1
054 POP FXP,T
055 071 024 MOVEI R,(T)
056 071 024 HRLI R,-1(T)
057 071 024 ADDI R,(P)
058 SKIPN T
059 131 052 SETZ R,
060 071 024 MOVEM R,-4(TT)
061 061 044 MOVE R,[$APPLYFRAME]
062 071 024 MOVEM R,-1(TT)
063 POPJ P,
064
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 213
001
002 214 019 UUOS9: SKIPA TT,CILIST ;*** LSUBR CALLED LIKE FSUBR
003 218 038 UUOS7: MOVEI TT,ARGPDL ;*** LSUBR CALLED LIKE SUBR
004 071 024 MOVE R,40
005 071 024 TLNN R,1000
006 022 058 PUSH P,UUOH
007 HLRZ T,(T)
008 071 024 TLNE R,(20←33) ;THE NCALL BIT
009 ADDI T,1
010 PUSH FXP,T
011 064 014 PUSH FXP,XC-1
012 SKIPN V.RSET
013 213 018 JRST UUOS7A
014 MOVEI T,1
015 208 010 PUSHJ P,UUOBAK
016 REPEAT 2, SOS -3(P) ;ALLOW FOR TWO FROBS ON FXP
017 HRRZM P,(FXP)
018 UUOS7A: JSP TT,(TT) ;ARGPDL OR ILIST
019 071 024 POP FXP,R
020 213 028 JUMPL R,UUOS7K
021 SKIPN TT,T
022 213 025 JRST UUOS7H
023 HRLI TT,-1(TT)
024 ADDI TT,1(P)
025 071 024 UUOS7H: MOVEM TT,-4(R)
026 061 044 MOVE TT,[$APPLYFRAME]
027 071 024 MOVEM TT,-1(R) ;APPLYFRAME DONE
028 022 063 UUOS7K: MOVEM T,UUTSV
029 022 062 HRRZ R,UUOFN
030 218 005 PUSHJ P,ARGLCK
031 210 049 JRST UUOS2E
032 POP FXP,T
033 MOVEI A,0
034 209 030 JRST UUOXIT
035
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 214
001
002
003 UUOS2A: HLRZ TT,(T) ;*** ARRAY CALLED LIKE FSUBR
004 MOVEM TT,LISAR
005 071 024 MOVEI R,(TT)
006 162 063 MOVEI TT,IAPAR1
007 214 011 JRST UUOS2Q
008
009 UUOS2: HLRZ TT,(T) ;*** SUBR CALLED LIKE FSUBR
010 022 062 HRRZ R,UUOFN
011 UUOS2Q: MOVE T,40
012 TLNN T,1000
013 022 058 PUSH P,UUOH
014 TLNE T,(NCALL)
015 210 041 PUSH P,[UUONVL]
016 162 063 CAIN T,IAPAR1
017 PUSH P,LISAR
018 PUSH FXP,TT ;SUBR ADDR
019 068 038 CILIST: JSP TT,ILIST ;ILIST FORTUNATELY SAVES R
020 218 003 PUSHJ P,ARGCHK
021 210 049 JRST UUOS2E
022 218 046 JSP R,PDLARG
023 POP FXP,TT ;PRESERVE T FOR UUOBKG
024 162 063 CAIN TT,IAPAR1
025 POP P,LISAR
026 022 068 JSR UUOBKG
027 MOVEI T,(TT) ;BEWARE! LOOSE SUBR POINTER
028 209 030 JRST UUOXIT
029
030 UUOS1A: HLRZ TT,(T) ;*** ARRAY CALLED LIKE LSUBR
031 MOVEM TT,LISAR
032 162 063 MOVEI T,IAPAR1 ;HAIR SO INTERRUPTS WON'T SCREW US
033 022 063 EXCH T,UUTSV
034 218 046 JSP R,PDLARG ;SAVES TT
035 022 068 JSR UUOBKG ;ALSO SAVES TT, AND WANTS NOTHING ON PDLS
036 071 024 LDB R,[TTSDIM,,TTSAR(TT)]
037 MOVE TT,40
038 TLNN TT,1000
039 022 058 PUSH P,UUOH
040 TLNE TT,(NCALL)
041 210 041 PUSH P,[UUONVL]
042 071 024 MOVNI R,(R)
043 071 024 CAMN R,T
044 209 031 JRST UUOXT1
045 181 046 PUSH FXP,D
046 060 041 PUSHJ P,SAVX3
047 181 046 MOVEI D,2
048 211 006 JRST UUOE2
049
050
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 215
001
002 ;;; PUTCODE [EXPR ← FSUBR]40
003
004 UUOS4: POP P,A ;*** FEXPR CALLED LIKE LSUBR
005 022 063 MOVN TT,UUTSV
006 216 004 JRST UUOS4A
007
008 UUF2N: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE FSUBR
009 UUOS6: HLRZ TT,(T) ;*** EXPR CALLED LIKE FSUBR
010 071 024 MOVE R,40
011 TLZN TT,-1 ;UUF2N LEAVES LH OF T ↑= 0
012 071 024 HRL TT,R ;OTHERWISE GET SUBR EXPR NAME IN LH
013 071 024 TLNN R,1000
014 022 058 PUSH P,UUOH
015 071 024 TLNE R,(20←33) ;THE NCALL BIT
016 210 041 PUSH P,[UUONVL]
017 212 002 JSP R,UUOX4B
018 SKIPN V.RSET
019 215 029 JRST UUOS6Q
020 PUSH P,FXP ;IF IN *RSET MODE, MAKE
021 HRLM FLP,(P) ; UP AN EVAL FRAME (SEE EVAL
022 035 006 MOVEI C,(A) ; FOR FORMAT THEREOF)
023 HRRZ B,40
024 073 009 PUSHJ P,XCONS ;MUST CONS UP FAKE ARG TO EVAL
025 PUSH P,A
026 HRLM SP,(P)
027 061 005 PUSH P,[$EVALFRAME]
028 035 006 MOVEI A,(C)
029 UUOS6Q: PUSH P,TT ;PUSH OF FUNCTION
030 161 015 MOVEI TT,IAPPLY
031 068 038 JRST ILIST
032
033 022 062 UUOS11: MOVEM T,UUOFN ;*** FSUBR CALLED LIKE LSUBR
034 022 063 MOVE T,UUTSV
035 216 035 JRST UUS10A
036
037 ;;; ENDCODE [EXPR ← FSUBR]
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 216
001
002
003 UUOS3: LDB TT,[270400,,40] ;*** FEXPR CALLED LIKE SUBR
004 UUOS4A: SOJN TT,UUOFER
005 UUOEX2: MOVEI TT,1 ;*** FEXPR CALLED LIKE FSUBR
006 DPB TT,[270400,,40]
007 TLOA A,400000
008 UUOS: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE SUBR
009 UUOEXP: HLRZ TT,(T) ;*** EXPR CALLED LIKE SUBR
010 LDB T,[270400,,40]
011 071 024 UUOEX4: MOVE R,40 ;ALL OF T,TT,R WILL BE LOST!
012 TLZN TT,-1 ;INSERT EXPR NAME IF WAS EXPR
013 071 024 HRL TT,R
014 071 024 TLNN R,1000
015 022 058 PUSH P,UUOH
016 MOVN T,T
017 SKIPE V.RSET
018 208 006 PUSHJ P,UUOBNC
019 071 024 TLNE R,(NCALL)
020 210 041 PUSH P,[UUONVL]
021 212 002 JSP R,UUOX4B
022 PUSH P,TT ;PUSH FUNCTION
023 161 015 JUMPE T,IAPPLY
024 022 063 MOVEM T,UUTSV
025 022 063 HRLZ R,UUTSV
026 071 024 MOVE A,1(R)
027 094 012 JSP T,PDLNMK
028 PUSH P,A ;PUSH ARGUMENT
029 071 024 AOBJN R,.-3
030 022 063 MOVE T,UUTSV
031 161 015 JRST IAPPLY ;APPLY FUN TO ARGS
032
033 022 062 UUOS10: MOVEM T,UUOFN ;*** FSUBR CALLED LIKE SUBR
034 218 038 JSP TT,ARGPDL
035 UUS10A: AOJN T,UUOFER
036 POP P,A
037 MOVSI T,2000
038 IORM T,40
039 022 062 MOVE T,UUOFN
040 209 003 JRST UUOSBR
041
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 217
001
002 UUL2N: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE LSUBR
003 UUOS5: HLRZ TT,(T) ;*** EXPR CALLED LIKE LSUBR
004 022 063 MOVE T,UUTSV
005 064 014 CAMGE T,XC-NACS
006 217 011 JRST UUOS5A
007 218 046 JSP R,PDLARG
008 MOVNS T
009 216 011 JRST UUOEX4
010
011 UUOS5A: PUSH FXP,T ;DAMN CASE WHERE WE MUST
012 PUSH FXP,V.RSET ; SLIDE STUFF UP THE PDL,
013 071 024 MOVEI R,(P) ; DOING PDLNMK'S AS WE GO
014 066 009 JSP T,NPUSH-3-NACS+1 ;ROOM FOR ALL ACS BUT A, PLUS 3
015 SKIPE (FXP)
016 066 009 JSP T,NPUSH-5 ;EXTRA SLOTS FOR *RSET
017 181 046 MOVEI D,(P)
018 MOVE F,-1(FXP)
019 071 024 UUOS5B: MOVE A,(R) ;SO DO ALL THE PDLNMK'S
020 094 012 JSP T,PDLNMK
021 181 046 MOVEM A,(D)
022 071 024 SUBI R,1
023 181 046 SUBI D,1
024 217 019 AOJL F,UUOS5B
025 HRL TT,40 ;TT HAS BEEN SAVED - HAS FN
026 181 046 MOVEM TT,(D) ;SAVE FUNCTION BELOW ARGS FOR IAPPLY
027 SKIPE (FXP) ;D SHOULD POINT TO WHERE ACS ARE SAVED
028 181 046 SUBI D,5 ;FOR *RSET, MUST SAVE THE ACS UNDER THE FRAME!
029 181 046 REPEAT NACS-1, MOVEM B+.RPCNT,.RPCNT-NACS(D) ;SAVE ALL MARKED ACS BUT A
030 060 020 MOVEI TT,R5M1PJ ;PROVIDE FOR RESTORING THEM
031 181 046 MOVEM TT,-1(D) ;ACS WERE SAVED UNDER, NOT OVER, THE
032 MOVE TT,40 ; FRAME IN CASE OF AN FRETURN
033 022 058 MOVE F,UUOH ;MAYBE NEED RETURN ADDRESS UNDER
034 TLNE TT,1000 ; THE ARGS (IF NOT, USE A CPOPJ)
035 059 031 MOVEI F,CPOPJ
036 181 046 MOVEM F,-NACS-1(D)
037 POP FXP,F
038 217 047 JUMPE F,UUOS5C ;MAYBE MORE *RSET HAIR?
039 PUSH FXP,(FXP) ;DUPLICATE NUMBER OF ARGS ON FXP
040 181 046 MOVEI TT,4(D) ;TT POINTS TO THE FIVE *RSET SLOTS
041 MOVEM TT,-1(FXP) ;PLOP POINTER INTO PDL SLOT
042 212 045 PUSHJ P,UUOFUL ;SET UP APPLYFRAME (POPS FXP)
043 POP FXP,TT
044 HRRZS (TT) ;FLUSH CPOPJ - IAPPLY WILL CREATE ONE
045 161 015 JRST IAPPLY
046
047 UUOS5C: POP FXP,T ;NOW FOR THE IAPPLY
048 161 015 JRST IAPPLY ;UUOFUL WANTS TWO THINGS ON FXP, WILL POP ONE
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 218
001
002
003 064 014 ARGCHK: CAMGE T,XC-NACS ;CHECK NUMBER OF ARGS SUPPLIED
004 218 047 JRST PAERR ;R HAS ATOM PROPERTY LIST POINTER
005 ARGLCK: SKIPE V.RSET
006 218 010 JRST ARGCK2
007 ARGCK1: POP P,TT ;FOR SPEED, DO THIS RATHER THAN
008 209 011 JRST 1(TT) ;AOS (P) POPJ P,
009
010 071 024 ARGCK2: SKOTT R,SY ;R HAS SYMBOL OR SAR
011 218 034 JRST ARGCK5 ;MUST BE A SAR
012 071 024 ARGCK0: HLRZ R,(R)
013 071 024 HLRZ R,1(R)
014 218 007 JUMPE R,ARGCK1
015 071 024 LDB TT,[111100,,R]
016 218 023 JUMPN TT,ARGCK3
017 071 024 ARGCK4: LDB TT,[001100,,R]
018 MOVNI TT,-1(TT)
019 CAMN T,TT
020 AOS (P)
021 POPJ P,
022
023 ARGCK3: MOVNI TT,-1(TT)
024 CAMLE T,TT
025 POPJ P,
026 071 024 LDB TT,[001100,,R]
027 CAIN TT,777 ;777 IS EFFECTIVELY INFINITY
028 059 039 JRST POPJ1
029 MOVNI TT,-1(TT)
030 CAML T,TT
031 AOS (P)
032 POPJ P,
033
034 071 024 ARGCK5: LDB R,[TTSDIM,,TTSAR(R)]
035 218 017 AOJA R,ARGCK4
036
037
038 ARGPDL: LDB T,[270400,,40] ;ARGS => PDL -CNT=> T
039 MOVNS T
040 071 024 ARGP0: HRLZ R,T
041 071 024 ARGP1: JUMPE R,(TT)
042 071 024 PUSH P,A(R)
043 071 024 AOBJN R,.-1
044 209 011 JRST (TT)
045
046 064 014 PDLARG: CAMGE T,XC-NACS
047 PAERR: LERR EMS16 ;MORE THAN 5 ARGS
048 209 011 JRST .+1+NACS(T)
049 REPEAT NACS,[CONC RSTR,\<A-1+NACS-.RPCNT>,: POP P,A-1+NACS-.RPCNT
050 ]
051 209 011 PDLA2: JRST (R)
052 181 046 MOVEI D,QSUBRCALL ;COME HERE IF SUBRCALL (Q.V.) GOT 0 ARGS
053 SOJA T,WNALOSE
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 219
001
002
003 022 063 STRTOUT: MOVE T,UUTSV
004 022 058 PUSH P,UUOH
005 PUSH P,A
006 060 036 PUSHJ P,SAVX5
007 PUSH FXP,40
008 002 048 IFN QIO,[
009 PUSH P,AR1
010 PUSH P,AR2A
011 181 046 LDB D,[270400,,(FXP)] ;AC=17 MEANS USE MSGFILES.
012 181 046 CAIN D,17
013 219 040 JRST ERP0D
014 181 046 SKIPN AR1,(D) ;NIL MEANS USE DEFAULT ↑R AND ↑W
015 219 044 JRST ERP0C
016 ERP0E: TLO AR1,200000
017 ERP0F: MOVEI A,(AR1)
018 005 042 LSH A,-SEGLOG
019 036 033 SKIPL ST(A) ;MAYBE SHOULD ERRR-CHECK BETTER?
020 TLO AR1,400000 ;NOTE WHETHER LIST OR NOT
021 068 059 ERP0A: JSP T,GTRDTB
022 .5LOCKI
023 ERBPLOC==-1 ;LOCATION OF BYTE PTR ON FXPDL
024 ] ;END OF IFN QIO
025 002 048 IFE QIO, ERBPLOC==0
026 181 046 MOVSI D,440600
027 219 023 HLLM D,ERBPLOC(FXP)
028 219 023 ERP1: ILDB TT,ERBPLOC(FXP) ;STRING BYTE POINTER IS STORED ON FXP
029 020 032 CAIN TT,'# ;THE .5LOCKI SAVED INHIBIT ON TOP OF FXP
030 219 052 JRST ERP3
031 CAIN TT,'!
032 219 064 JRST ERP6
033 CAIN TT,'↑
034 219 055 JRST ERP4
035 ERP5: ADDI TT,40
036 ERP5A: PUSHJ P,STRTYO
037 219 028 JRST ERP1
038
039 002 048 IFN QIO,[
040 ERP0D: SKIPN AR1,VMSGFILES
041 219 067 JRST ERP6A
042 219 016 JRST ERP0E
043
044 ERP0C: SKIPE AR1,TAPWRT
045 HRRZ AR1,VOUTFILES
046 219 017 JUMPN AR1,ERP0F
047 SKIPE TTYOFF
048 219 067 JRST ERP6A
049 219 021 JRST ERP0A
050 ] ;END OF IFN QIO
051
052 219 023 ERP3: ILDB TT,ERBPLOC(FXP) ;QUOTE A CHAR
053 219 035 JRST ERP5
UUOH HANDLER (INCLUDING STRT) LISP.393[MAC,LSP] 01/17/78 Page 219.1
054
055 219 023 ERP4: ILDB TT,ERBPLOC(FXP) ;CONTROLLIFY A CHAR
056 ADDI TT,40
057 TRC TT,100
058 Q$ CAIE TT,↑M
059 219 036 JRST ERP5A
060 Q$ PUSHJ P,STRTYO
061 Q$ MOVEI TT,↑J
062 219 036 Q$ JRST ERP5A
063
064 ERP6:
065 002 048 IFN QIO,[
066 UNLOCKI ;DONE!
067 ERP6A: POP P,AR2A
068 POP P,AR1
069 ] ;END OF IFN QIO
070 064 009 SUB FXP,R70+1 ;FLUSH BYTE PTR
071 POP P,A ;RESTORE A
072 060 046 JRST RSTX5 ;RESTORE NUMACS AND POPJ
073
074 ENDFUN==.-1 .SEE SSYSTEM ;NO MORE FUNCTIONS BEYOND HERE
INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 220
001
002 SUBTTL INITIAL STARTUP CODE
003
004 ;;; NORMAL }G STARTUP CODE. ON FIRST RUN, THE ALLOC PHASE COMES HERE;
005 ;;; THEREAFTER, LISPGO COMES HERE DIRECTLY.
006 ;;; WE DO NOT HAVE THE USE OF THE PDLS UNTIL THE CALL TO ERINIX.
007 ;;; WE DO NOT HAVE THE USE OF CONSING OF ANY SORT UNTIL THE CALL TO GCNRT.
008
009 LISP:
010 ;CLEAR AND DISABLE INTERRUPT SYSTEM
011 002 026 IFN ITS,[
012 064 009 .SUSET [.SPICLR,,R70]
013 064 009 .SUSET [.SPIRQC,,R70]
014 064 009 .SUSET [.SIFPIR,,R70]
015 .SUSET [.ROPTION,,TT]
016 Q$ TLO TT,OPTINT+OPTOPC ;NEW-STYLE INTERRUPTS AND NO PC SCREWAGE
017 Q$ .SUSET [.SOPTION,,TT]
018 TLNN TT,OPTBRK ;IF OUR SUPERIOR CLAIMS TO HANDLE BREAKS,
019 220 027 JRST LISP17 ; AND IF IT CLAIMS TO HAVE LISP'S SYMBOL TABLE LOADED,
020 .BREAK 12,[..RSTP,,TT] ; THEN VALRET A STRING WHICH WILL CAUSE }& TYPEOUT MODE
021 SKIPGE TT ; TO BE S-EXP TYPEOUT (AND }% TO BE SQUOZE)
022 173 087 .VALUE [ASCIZ /↔:IF N :SYMTYP P%
023 }(..TAMP\
024 ..TPER\}1Q
025 145 026 ..TAMP\P%
026 }):VP /]
027 LISP17:
028 ] ;END OF IFN ITS
029 030 024 10$ SETZM UPCOK
030 005 005 10$ WARN [D10 INTERRUPT SYSTEM RESET?]
031 005 006 20$ WARN [D20 INTERRUPT SYSTEM RESET?]
032
033 ;CONSIDER SHARING PAGES WITH OTHER JOBS
034 221 092 IFN USELESS*<1-D10>, JSP T,SHAREP
035
036 ;RESET I/O SWITCHES
037 IT$ Q% SETZM LPTOPD ;LINE PRINTER CHANNEL
038 030 007 Q% SETZM UTOOPD ;UWRITE CHANNEL
039 030 008 Q% SETZM UTIOPD ;UREAD CHANNEL
040 002 039 IFN MOBIOF,[
041 SETZM FTVU ;FAKE TV
042 SETZM BVDOPD ;VIDISECTOR
043 SETZM NVDOPD
044 SETZM DISOPD ;340 DISPLAY
045 SETZM DISPON
046 ] ;END OF IFN MOBIOF
047 IT$ Q% SETZM LPTON ;LINE PRINTER FLAG (↑B)
048 SETZM TAPWRT ;UWRITE FLAG (↑R)
049 SETZM TTYOFF ;TTY OUTPUT FLAG (↑W)
050 035 006 Q% MOVEI T,<↑C>←13 ;RESTORE VERY IMPORTANT ↑C AT END OF
051 035 041 Q% HRLZM T,UTIB+UTBSIZ ; UREAD BUFFER (IN CASE WAS CLOBBERED)
052 031 004 IFN EDFLAG, SETOM EDPRFL ;EDITOR'S PRINTOUT FLAG
053 002 049 IFN JOBQIO,[
INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 220.1
054 IT$ .DTTY ;SAY THIS JOB WANTS THE TTY, RATHER
055 IT$ JFCL ; THAN LETTING AN INFERIOR HAVE IT
056 004 046 IT% WARN [RETRIEVE TTY FROM INFERIOR?]
057 ] ;END OF IFN JOBQIO
058
059 ;RESET FREELISTS TO FORCE A CLEAN GARBAGE COLLECTION
060 023 014 REPEAT NFF, SETZM FFS+.RPCNT ;SET FREELISTS TO NIL
061 131 052 IFN HNKLOG+DBFLAG+CXFLAG, MOVSI A,(SETZ)
062 002 050 REPEAT HNKLOG,[
063 026 012 SKIPN HNSGLK+.RPCNT ;HACK TO AVOID CREATING
064 023 022 MOVEM A,FFH+.RPCNT ; UNNEEDED HUNK SEGMENTS
065 ] ;END OF REPEAT HNKLOG
066 026 007 DB$ SKIPN DBSGLK ;DITTO FOR WEIRD NUMERIC TYPES
067 023 017 DB$ MOVEM A,FFD ;THE SETZ BIT IN THE FREELIST
068 026 008 CX$ SKIPN CXSGLK ; POINTER MEANS IT IS OKAY TO
069 023 018 CX$ MOVEM A,FFC ; HAVE NO FREE CELLS AS LONG AS
070 026 009 DX$ SKIPN DXSGLK ; NO ONE TRIES TO CONS ONE
071 023 019 DX$ MOVEM A,FFZ
072 024 069 SETZM GCTIM ;RESET GC TIME (SINCE RUNTIME PROBABLY GOT RESET?)
073 030 049 SETZM ALGCF ;RESET ALLOC FLAG - OKAY TO GC NOW
074
075 045 004 JSP T,TLVRSS ;RESET VARIOUS "TOP LEVEL VARIABLES"
076 046 013 JSP A,ERINIX ;SET UP PDLS, RESTORE MUNGED DATA, ENABLE INTERRUPTS
077
078 ;INITIALIZE DEFAULT DIRECTORY NAMES
079 002 026 IFN ITS,[
080 030 002 MOVE TT,IUSN
081 030 004 Q% MOVEM TT,USN
082 030 004 Q% .SUSET [.SSNAM,,USN]
083 018 027 Q$ MOVEM TT,TTYIF2+F.SNM
084 018 027 Q$ MOVEM TT,TTYOF2+F.SNM
085 ] ;END OF IFN ITS
086 005 005 IFN D10,[
087 SA% GETPPN T, ;FOR TOPS10/CMU, USE GETPPN
088 SA% JFCL ; (GETS PPN OF CURRENT JOB)
089 131 052 SA$ SETZ T, ;FOR SAIL, WE PREFER DSKPPN
090 SA$ DSKPPN T, ; (AS SET BY THE ALIAS COMMAND)
091 030 004 Q% MOVEM T,USN
092 168 004 Q$ WARN [WHAT TO DO WITH DIR NAME?]
093 ] ;END OF IFN D10
094
095 ;TRY TO OPEN THE TERMINAL AS AN I/O DEVICE
096 002 026 IFN ITS,[
097 221 011 Q% PUSHJ P,TTYOPN
098 Q$ PUSHJ P,OPNTTY
099 JFCL
100 ] ;END OF IFN ITS
101 002 048 IFN D10*<1-QIO>,[
102 MOVEI A,IN0+72. ;TTY ALREADY "OPEN" FOR D10,
103 MOVEM A,VLINEL ; BUT RESET LINEL
104 032 048 MOVEM A,OLINEL
105 ] ;END OF IFN D10*<1-QIO>
106
INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 220.2
107 ;PERFORM INITIAL GARBAGE COLLECTION (BUT DON'T BOTHER TO COMPACT ARRAYS)
108 MOVSI T,111111
109 PUSHJ P,GCNRT
110
111 ;INITIALIZE THE NAME OF THE MACHINE IN THE FEATURES LIST
112 002 026 IFN ITS,[
113 221 004 .CALL LISP43 ;GETS NAME OF ITS (AI, MC, ML, DM) IN TT
114 .VALUE
115 052 027 PUSHJ P,SIXATM ;CONVERT TO ATOMIC SYMBOL
116 HRLM A,MACHFT ;SET UP (STATUS FEATURES) FOR MACHINE NAME
117 ] ;END OF IFN ITS
118
119 027 004 MOVE TT,BPSH ;IF BPEND SOMEHOW
120 CAMGE TT,@VBPEND ; IS LARGER THAN BPSH,
121 PUSHJ P,BPNDST ; SET IT EQUAL TO BPSH
122
123 045 030 10$ PUSHJ P,SIXJBN ;INITIALIZE TEMP FILE NAME D10NAM
124
125 ;INITIALIZE (STATUS UDIR)
126 005 005 IFN D10,[
127 002 029 IFE SAIL,[
128 MOVNI T,1 ;FOR NON-SAIL, TRY TO GET
129 181 046 SETZB TT,D ; DEFAULT SNAME BY USING PATH.
130 071 024 MOVEI R,0
131 MOVE F,[4,,T]
132 PATH. F,
133 ] ;END OF IFE SAIL
134 030 004 MOVE D,USN ;ON FAILURE, JUST USE USN
135 PUSHJ P,SUNM2 ;CREATE A PPN OF APPROPRIATE FORMAT
136 ] ;END OF IFN D10
137 002 026 IFN ITS,[
138 030 002 MOVE TT,IUSN ;TAKE INITIAL SNAME
139 052 027 PUSHJ P,SIXATM ;CONVERT TO ATOMIC SYMBOL
140 ] ;END OF IFN ITS
141 20$ WARN [INITIALIZE (STATUS UDIR)]
142 MOVEM A,SUDIR
143 ;INITIALIZE CURRENT UNIT
144 002 048 IFE QIO,[
145 073 008 PUSHJ P,NCONS
146 MOVEI B,QDSK
147 073 009 PUSHJ P,XCONS
148 MOVEM A,IUNIT ;INSTALL CURRENT USER IN IUNIT
149 ] ;END OF IFE QIO
150
151 002 039 IFN MOBIOF, PUSHJ P,CLSSIX ;CLOSE THE PDP-6
152
153 ;INITIALIZE VARIOUS BIZARRE TOP-LEVEL VARIABLES
154 MOVEI T,INR70 ;LOCATION OF LAP CONSTANTS
155 MOVEM T,VTTSR
156 MOVEI A,Q. ;INITIAL VALUE OF * IS *
157 MOVEM A,V.
158 MOVE A,VERRLIST ;SET UP FOR EVAL'ING ERRLIST
159 MOVEM A,VIQUOTIENT
INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 220.3
160 030 050 SKIPGE AFILRD
161 040 025 JRST LSPRET
162 LIHAC:
163 030 008 Q% AOS UTIOPD ;HAIRY HAC TO READ, THE FIRST TIME
164 030 050 SETOM AFILRD ; AROUND, FROM THE .LISP. (INIT) FILE
165 MOVEI A,TRUTH
166 MOVEM A,TAPRED ;(SETQ ↑Q T)
167 040 034 JRST HACENT
INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 221
001
002 002 026 IFN ITS,[
003
004 131 052 LISP43: SETZ
005 SIXBIT \SSTATU\
006 REPEAT 5, 2000,,TT ;IGNORE USELESS GARBAGE
007 402000,,TT ;MACHINE NAME
008
009
010 002 048 IFE QIO,[
011 221 051 TTYOPN: .OPEN TYIC,OTYIC
012 006 121 .LOSE 1000
013 221 055 .OPEN TYOC,OTYOC
014 006 121 .LOSE 1000
015 221 066 .CALL RTTYS
016 006 121 .LOSE 1400
017 071 024 TLO R,%TS<CLE+ACT+MOR>
018 030 039 MOVEM R,STTYSS
019 221 041 .CALL CNSGT1
020 006 121 .LOSE 1400
021 ANDI TT,777
022 181 046 IOR D,TT
023 030 042 MOVEM D,TTYDISP
024 030 037 MOVEM D,SRNLN1
025 MOVEI A,IN0(TT) ;A NUMBER FOR TTY TYPE
026 MOVEM A,VTTY ; (GUARANTEED NLISP INUM)
027 221 073 JSP T,WAKTTY
028 221 060 .CALL RSSBLK ;WANT TO LEAVE IN ACC TT THE WIDTH OF THE SCREEN IN CHARS
029 006 121 .LOSE
030 SUBI TT,1 ;LINE LENGTH RETURNED BY SYSTEM MAY BE 2 TOO LONG
031 181 046 SUBI D,1
032 030 037 SKIPE SRNLN1
033 030 037 MOVEM D,SRNLN1
034 CAILE TT,777 ;CONCEIVABLY THE LINEL IS SET HUGE
035 MOVEI TT,777
036 MOVEI A,IN0(TT) ;SET UP LINEL (GUARANTEED NLISP INUM)
037 MOVEM A,VLINEL
038 032 048 MOVEM A,OLINEL
039 POPJ P,
040
041 131 052 CNSGT1: SETZ
042 SIXBIT \CNSGET\
043 010 009 1000,,TYIC
044 2000,,TT
045 2000,,TT
046 2000,,TT
047 181 046 2000,,D
048 181 046 402000,,D
049
050
051 004 046 OTYIC: (SIXBIT \TTY\)
052 SIXBIT \.LISP.\
053 SIXBIT \INPUT\
INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 221.1
054
055 004 046 OTYOC: (21+SIXBIT \TTY\)
056 SIXBIT \.LISP.\
057 SIXBIT \OUTPUT\
058
059
060 131 052 RSSBLK: SETZ
061 SIXBIT \RSSIZE\
062 010 009 1000,,TYIC
063 2000,,TT+1 ;SCREEN HEIGHT
064 402000,,TT ;SCREEN WIDTH (LINEL)
065
066 131 052 RTTYS: SETZ
067 SIXBIT \TTYGET\
068 010 009 1000,,TYIC
069 2000,,TT ;TTYST1 (WORD ONE CHARACTER BITS)
070 181 046 2000,,D ;TTYST2 (WORD TWO)
071 071 024 402000,,R ;TTYSTS
072
073 221 077 WAKTTY: .CALL STTYS
074 .VALUE
075 209 011 JRST (T)
076
077 131 052 STTYS: SETZ
078 SIXBIT \TTYSET\
079 010 009 1000,,TYIC
080 030 040 STTYS1 ;TTYST1
081 030 041 STTYS2 ;TTYST2
082 030 039 400000,,STTYSS ;TTYSTS
083 ] ;END OF IFE QIO
084
085 ] ;END OF IFN ITS
086
087 209 011 10$ WAKTTY: JRST (T)
088
089
090 002 026 IFN ITS,[
091 209 011 NOSHARE==JRST (T) ;DEPOSIT INTO SHAREP TO INHIBIT SHAREING
092 032 053 SHAREP: SKIPN SAWSP
093 209 011 JRST (T)
094 032 053 SETZM SAWSP
095 221 111 .CALL PURCHK
096 .VALUE
097 JUMPLE TT,(T)
098 017 021 .OPEN TMPC,SYSFIL
099 209 011 JRST (T)
100 017 021 .ACCESS TMPC,[2000+BPURPG]
101 007 033 MOVE TT,[-NPURPG,,BPURPG/PAGSIZ]
102 221 121 .CALL PURPGS ;SHARE PURE CODE
103 .VALUE
104 017 021 .ACCESS TMPC,[2000+BPURFS-<NXVCSG+NXXZSG>*SEGSIZ]
105 007 033 MOVE TT,[-NPURFS,,BPURFS/PAGSIZ]
106 221 121 .CALL PURPGS ;SHARE PURE DATA AREAS
INITIAL STARTUP CODE LISP.393[MAC,LSP] 01/17/78 Page 221.2
107 .VALUE
108 017 021 .CLOSE TMPC,
109 209 011 JRST (T)
110
111 131 052 PURCHK: SETZ
112 SIXBIT \CORTYP\ ;GET TYPE FOR CORE BLOCK
113 007 033 1000,,BPURPG/PAGSIZ ;LOWEST PURE BLOCK
114 402000,,TT ;>0 READ-ONLY, <0 WRITABLE
115
116 SYSFIL: SIXBIT \ &SYS\ ;FOR OPENING UP FILE TO SHARE
117 Q% SIXBIT \PURBIB\
118 Q$ SIXBIT \PURQIO\
119 004 006 LVRNO
120
121 131 052 PURPGS: SETZ
122 SIXBIT \CORBLK\ ;HACK CORE BLOCKS
123 1000,,200000 ;GET READ-ONLY PAGES
124 1000,,-1 ;PUT THEM INTO *MY* PAGE MAP
125 ,,TT ;AOBJN POINTER FOR PAGES
126 017 021 401000,,TMPC ;DISK FILE TO SHARE WITH
127
128 ] ;END OF IFN ITS
JCL INITIALIZATION ROUTINE LISP.393[MAC,LSP] 01/17/78 Page 222
001
002 SUBTTL JCL INITIALIZATION ROUTINE
003
004 005 006 20$ WARN [D20 JCL?]
005
006 005 005 IFN D10,[
007
008 131 052 JCLSET: SETZ D,
009 033 173 MOVE R,[440700,,SJCLBUF+1]
010 SA% RESCAN
011 SA$ RESCAN A
012 SA% CAIA
013 SA$ SKIPN A
014 222 041 JRST JCST3
015 JCST4: INCHRS B
016 222 041 JRST JCST3
017 CAIE B,↑M ;IF <CR> OR <ALT> OCCURS ON COMMAND
018 CAIN B,33
019 222 041 JRST JCST3 ;BEFORE A ";", THEN NO JCL
020 CAIE B,";
021 CAIN B,"(
022 CAIA
023 222 015 JRST JCST4 ;LOOP UNTIL WE FIND A ; OR (
024 033 172 MOVNI D,BYTSWD*LSJCLBUF
025 JCST2: INCHRS A
026 222 038 JRST JCST1
027 CAIN B,"( ;IF JCL STARTED WITH A (,
028 CAIE A,") ; ONLY UP TO THE ) IS JCL,
029 CAIA ; BUT WE MUST GOBBLE THE WHOLE LINE
030 SETO B,
031 222 034 JUMPL B,JCST5
032 181 046 AOSG D
033 071 024 IDPB A,R
034 JCST5: CAIN A,↑M ;<CR> OR <ALT> TERMINATES
035 222 038 JRST JCST1 ;THE COMMAND LINE
036 CAIE A,33
037 222 025 JRST JCST2
038 181 046 JCST1: SKIPLE D
039 181 046 TDZA D,D ;TOO MUCH JCL => NONE AT ALL
040 033 172 ADDI D,BYTSWD*LSJCLBUF
041 JCST3: INCHRS A ;MAKE SURE NO SUPERFLUOUS CHAR
042 JFCL
043 033 173 MOVEM D,SJCLBUF
044 131 052 SETZ A,
045 071 024 IDPB A,R ;INSURE AT LEAST ONE NULL BYTE FOLLOWING THE LINE
046 209 011 JRST (F)
047
048 ] ;END OF IFN D10
INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 223
001
002 SUBTTL INTERNAL PCLSR'ING ROUTINES
003
004 SFXTBL: ;TABLE OF LOCATIONS FOR SFX HACK
005 013 023 MACROLOOP NSFC,ZZM,*
006
007 SFXTBI: ;TABLE OF INSTRUCTIONS NORMALLY IN THOSE LOCATIONS
008 013 026 MACROLOOP NSFC,ZZN,*
009
010 PROTB: ;TABLE OF INTERRUPT PROTECTION INTERVALS
011 011 015 MACROLOOP NPRO,PRO,*
012
013
014 ;;; TABLE MUST BE AN EXACT POWER OF TWO IN LENGTH SO WE CAN
015 ;;; USE SUPER-WINNING BINARY SEARCH METHOD.
016 223 010 HAOLNG LOG2NPRO,<.-PROTB-1>
017
018 226 039 REPEAT <1←LOG2NPRO>-NPRO,[ INTOK,,777777
019 ] ;END OF REPEAT <1←LOG2NPRO>-NPRO
020
021 ;;; IT IS OBVIOUSLY USELESS TO USE PROTECT MACROS BEYOND THIS POINT.
022 ;;; EXPUNGING NPRO WILL CAUSE AN ERROR IF THE PROTECT MACROS ARE USED
023 011 015 EXPUNGE NPRO
INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 224
001
002 002 048 IFE QIO,[
003
004 ;INTWAIT: 0
005 015 029 INTW0: MOVEM C,QITC ;.SUSET PIHOLD TO BE DONE BEFORE ENTERING
006 015 030 MOVEM D,QITD ; (INTERRUPT ENTRY IN EFFECT IS A PIHOLD)
007 015 031 MOVEM R,QITR
008 015 056 SKIPE WAITFL
009 226 046 JRST INTW4 ;BUSY DOING SFX HACK - GO STACK UP INTERRUPT
010 015 019 HLRZ C,NOQUIT ;IF IN GC, NEEDN'T CHECK SP - IT WILL
011 225 024 JUMPN C,INTW1 ; UNDOUBTEDLY BE IN STRANGE STATE ANYWAY
012 035 006 MOVE C,(SP) ;ALLOWS SPDL TO GET CAUGHT UP,
013 181 046 MOVEI D,(SP) ; OR CONSER TO FINISH HIS EXCH'S,
014 027 068 CAME D,ZSC2 ; BUT SKIPS 1 IF IN GC
015 014 066 CAMN C,SPSV ; (LH OF NOQUIT NONZERO)
016 225 024 JRST INTW1
017 015 056 INTSFX: SETOM WAITFL ;SET FLAG FOR SFX HACKERY
018 015 057 MOVEM A,WAITA ;SAVE A
019 020 015 MOVE A,INT
020 016 011 MOVE D,[JSR SPWR]
021 071 024 MOVSI R,-NSFC
022 223 004 MOVEM D,@SFXTBL(R) ;CLOBBER LOCATIONS MARKED BY SFX SO
023 071 024 AOBJN R,.-1 ; SFXPRO'ED ROUTINE WILL RETURN HERE
024 015 030 MOVE D,QITD ;RESTORE ACS
025 015 029 MOVE C,QITC
026 015 031 MOVE R,QITR
027 002 026 IFN ITS,[
028 009 020 .SUSET [.SDF1,,[<-1>#<IB.PDLOV+IB.MPV+IB.ILOP+IB.PUR>]]
029 015 058 .SUSET [.RDF2,,WAITD2] ;DEFER MOST NON-NASTY INTERRUPTS
030 064 014 .SUSET [.SDF2,,XC-1]
031 020 016 .DISMISS IPCLOK ;ENABLE INTERRUPTS IN CASE OF PDL OVERFLOW, ETC.
032 ] ;END OF IFN ITS
033 020 016 10$ JRST 2,@IPCLOK
034 166 064 10X WARN [INTERRUPT RETURN IN TENEX]
INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 225
001
002 ;;; IFE QIO
003
004 ;SPWR: 0
005 SPWR0: PIOF
006 002 026 IFN ITS,[
007 064 009 .SUSET [.SDF1,,R70]
008 015 058 .SUSET [.SDF2,,WAITD2]
009 ] ;END OF IFN ITS
010 015 031 MOVEM R,QITR
011 015 029 MOVEM C,QITC ;SAVE ACS
012 015 030 MOVEM D,QITD
013 020 015 MOVEM A,INT
014 015 057 MOVE A,WAITA
015 071 024 MOVSI R,-NSFC
016 223 007 MOVE D,SFXTBI(R) ;RESTORE LOCATIONS CLOBBERED BY JSR'S
017 223 004 MOVEM D,@SFXTBL(R)
018 071 024 AOBJN R,.-2
019 016 011 SOS C,SPWR ;BACK UP PC TO CLOBBERED INSTRUCTION
020 020 016 MOVEM C,IPCLOK
021 015 056 SETZM WAITFL ;SURVIVED SFX HACK - EVERYTHING'S HAPPY
022 226 044 JRST INTW2
023
024 020 016 INTW1: HRRZ C,IPCLOK
025 226 039 JUMPE C,INTOK
026 181 046 MOVEI D,0 ;FAST BINARY SEARCH OF PROTECT TABLE
027 REPEAT LOG2NPRO,[
028 223 010 MOVE R,PROTB+<1←<LOG2NPRO-.RPCNT-1>>(D)
029 071 024 CAIL C,(R)
030 181 046 ADDI D,1←<LOG2NPRO-.RPCNT-1>
031 ] ;END OF REPEAT LOG2NPRO
032 223 010 HLRZ R,PROTB(D)
033 209 011 JRST (R) ;GO TO PLACE WHICH HANDLES THIS INTERVAL
034
035 015 031 INTXCT: MOVE R,QITR ;RESTORE ACS
036 015 030 MOVE D,QITD
037 015 029 MOVE C,QITC
038 020 015 EXCH A,INT ;NOTE: FLAGS ARE NOT RESTORED
039 020 016 XCT @IPCLOK ;EXECUTE AN INSTRUCTION
040 209 011 JRST .+2
041 020 016 AOS IPCLOK ;HANDLE SKIPS CORRECTLY - SEE UUOACL
042 020 016 AOS IPCLOK
043 015 029 MOVEM C,QITC
044 015 030 MOVEM D,QITD
045 015 031 MOVEM R,QITR
046 020 015 EXCH A,INT
047 225 024 JRST INTW1 ;TRY AGAIN - MAYBE MORE TO XCT
INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 226
001
002 ;;; IFE QIO
003
004 023 046 INTSYP: SOS NPFFY2 ;PROTECT SYMBOL CONSER
005 023 046 INTSYQ: SOS NPFFY2
006 072 013 INTSYX: MOVEI C,SYCONS
007 226 038 JRST INTBK1
008
009 223 010 INTROT: MOVE C,PROTB(D) ;PROTECT CODE OF THE FORM
010 035 006 SUBI C,1 ; ROT A,-SEGLOG
011 020 016 HRRM C,IPCLOK ; ... MUNCH ...
012 020 015 EXCH A,INT ; ROT A,SEGLOG
013 005 042 ROT A,SEGLOG
014 020 015 EXCH A,INT
015 226 039 JRST INTOK
016
017 223 010 INTPPC: MOVE C,PROTB(D) ;PROTECT PURE CONSER
018 035 006 SUBI C,1 ;BACK UP TO THE AOSL OR WHATEVER
019 020 016 HRRM C,IPCLOK
020 035 006 SOS @(C) ;RESTORE THE COUNTER
021 226 039 JRST INTOK
022
023 020 015 INTC2X: HLRM B,INT ;MUST PROTECT LEFT HALF OF B FOR CONS
024 073 012 MOVEI C,CONS1 ;HAIRY KIND OF BACKUP FOR CONS
025 226 038 JRST INTBK1
026
027 022 063 INTACT: HRRZ C,UUTSV ;UUOACL
028 225 024 JRST INTW1
029
030 002 048 IFE QIO,[
031 035 006 INTTYI: MOVEI C,TYIN ;PROTECTS THE CASE OF PTYBF FILLED
032 226 038 JRST INTBK1 ; WHEN INTERRUPTED FROM TTYTYI
033 ] ;END OF IFE QIO
034
035 020 015 INTZAX: SETZM INT ;FOR CONSERS WHICH DON'T WANT TO PROTECT THEIR FREELIST!
036 020 015 INTACX: MOVSS INT ;FOR ACONS (RESTORES A FOR BACKUP)
037 223 010 INTBAK: MOVE C,PROTB(D) ;BACK UP PC TO BEGINNING
038 020 016 INTBK1: HRRM C,IPCLOK ; OF INTERVAL
039 INTOK:
040 035 006 10$ CAIL C,400000 ;NO ARRAYS IN HIGH SEGMENT!
041 226 044 10$ JRST INTW2
042 035 006 CAML C,@VBPEND
043 224 017 JRST INTSFX
044 015 019 INTW2: HLRZ C,NOQUIT
045 226 054 JUMPE C,INTW5
046 016 008 INTW4: AOS C,INTWAIT ;GC IS IN PROGRESS - CAUSES SKIP UPON EXIT
047 035 006 MOVEI C,(C)
048 204 021 CAIN C,INTW3
049 SKIPN @UINTTB(A)
050 226 054 JRST INTW5
051 015 030 MOVE D,QITD ;MUST RESTORE D AND R SO UISTAK
052 015 031 MOVE R,QITR ; CAN SAVE THEM AGAIN
053 016 004 JSR UISTAK ;STACK UP, IF PI IS USER-ENABLED
INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 226.1
054 015 030 INTW5: MOVE D,QITD ;RESTORE ACS
055 015 031 MOVE R,QITR
056 015 029 MOVE C,QITC
057 016 008 JRST 2,@INTWAIT ;RETURN TO CALLER
058
059 ] ;END OF IFE QIO
INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 227
001
002 002 048 IFN QIO,[
003
004 ;;; PUSHJ FXP,IWAIT
005 ;;; CALLED FROM WITHIN A NORMAL INTERRUPT HANDLER TO DECIDE
006 ;;; WHETHER IT IS SAFE TO ISSUE A USER INTERRUPT.
007 ;;; ON FAILURE, STACKS UP THE INTERRUPT AND SKIPS.
008 ;;; AS FOR UINT0, D CONTAINS THE INTERRUPT DESCRIPTOR WORD.
009 ;;; INTERRUPTS MUST BE DEFERRED; PDL OVERFLOW MUST BE
010 ;;; ENABLED. THE CONTENTS OF INTPDL POINTS TO THE INTPDL ENTRY
011 ;;; FOR THE CURRENT INTERRUPT, WHICH CONTAINS THE SAVED
012 ;;; CONTENTS OF D AND R. FXP MUST BE IN A USABLE STATE.
013
014
015 015 019 IWAIT: HLRZ R,NOQUIT ;IF IN GC, WE ARE IN A BAD STATE
016 229 047 JUMPN R,IWSTAK ; AND SO MUST STACK THE INTERRUPT
017 028 050 HRRZ R,INTPDL
018 028 050 CAIE R,INTPDL+LIPSAV ;FOR NESTED PI LEVEL (E.G. PDL OVERFLOW),
019 182 031 JRST IWSTAK .SEE INTXIT ; ALSO STACK THE INTERRUPT
020 071 024 MOVEI R,(SP) ;IF THE SPECPDL IS IN SOME
021 MOVE F,(SP) ; KIND OF STRANGE STATE (E.G.
022 027 068 CAME R,ZSC2 ; INTERRUPTED OUT OF SPECBIND)
023 014 066 CAMN F,SPSV ; THEN MUST DO THE INTSFX HACK
024 228 004 JRST IWLOOK
025 227 040 INTSFX: MOVE F,[PUSHJ FXP,SPWIN]
026 013 016 MOVSI R,-NSFC .SEE SFX
027 223 004 MOVEM F,@SFXTBL(R) ;CLOBBER LOCATIONS MARKED BY SFX SO
028 071 024 AOBJN R,.-1 ; SFXPRO'ED ROUTINE WILL RETURN TO SPWIN
029 028 050 HRRZ F,INTPDL ;RESTORE AC'S, AND SAVE
030 028 038 EXCH D,IPSD(F) ; INTERRUPT DESCRIPTOR
031 028 039 MOVE R,IPSR(F)
032 028 037 PUSH FXP,IPSPC(F) ;GET PC AND FLAGS
033 028 040 MOVEI F,IPSF(F)
034 PUSH FXP,F
035 MOVE F,(F)
036 209 011 JRST 2,@-1(FXP) ;CONTINUE WHATEVER WE WERE DOING
037
038 ;;; RETURN FROM SFX HACK. ROUTINE HAS DONE PUSHJ FXP,SPWIN.
039
040 SPWIN: MOVEM F,@-1(FXP) ;PRESERVE F
041 028 050 HRRZ F,INTPDL
042 028 037 POP FXP,IPSPC(F) ;PUT PC BACK INTO INTPDL FRAME,
043 028 037 SOS IPSPC(F) ; BACKED UP TO THE CLOBBERED INSTRUCTION
044 064 009 SUB FXP,R70+2
045 028 039 MOVEM R,IPSR(F) ;SAVE ACS D AND R
046 028 038 EXCH D,IPSD(F)
047 071 024 MOVSI R,-NSFC
048 223 007 SPWIN1: MOVE F,SFXTBI(R) ;RESTORE THE LOCATIONS THAT WE
049 223 004 MOVEM F,@SFXTBL(R) ; CLOBBERED WITH PUSHJ FXP,SPWIN
050 227 048 AOBJN R,SPWIN1
051 229 042 JRST IWWIN ;WE HAVE WON
INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 228
001
002 ;;; IFN QIO
003
004 028 050 IWLOOK: HRRZ F,INTPDL ;FAST BINARY SEARCH OF PROTECT
005 028 037 HRRZ R,IPSPC(F) ; TABLE ON PC INTERRUPTED FROM
006 181 046 PUSH FXP,D
007 181 046 MOVEI D,0
008 REPEAT LOG2NPRO,[
009 223 010 MOVE F,PROTB+<1←<LOG2NPRO-.RPCNT-1>>(D)
010 071 024 CAIL R,(F)
011 181 046 ADDI D,1←<LOG2NPRO-.RPCNT-1>
012 ] ;END OF REPEAT LOG2NPRO
013 223 010 MOVS R,PROTB(D)
014 181 046 POP FXP,D
015 028 050 HRRZ F,INTPDL ;A USEFUL VALUE FOR F
016 209 011 JRST (R) ;GO TO PLACE WHICH HANDLES THIS INTERVAL
017
018 ;;; COME HERE TO MOVE THE PC FORWARD OUT OF A PROTECTED INTERVAL
019 ;;; BY EXECUTING INTERVENING INSTRUCTIONS. THE ACS ARE CORRECTLY
020 ;;; AVAILABLE DURING THIS EXECUTION, EXCEPT FXP. THE PC FLAGS ARE
021 ;;; NOT PRESERVED. THUS, CODE IN SUCH A PROTECTED INTERVAL SHOULD
022 ;;; NOT USE FXP OR THE PC FLAGS. NO JUMP INSTRUCTIONS MAY BE USED;
023 ;;; HOWEVER, SKIPS ARE HANDLED CORRECTLY.
024 .SEE XCTPRO
025
026 028 037 INTXCT: PUSH FXP,IPSPC(F)
027 028 038 EXCH D,IPSD(F) ;RESTORE ACS D, R, AND F
028 028 033 MOVE R,IPSWD1(F) ;FLAGS ARE *NOT* RESTORED
029 028 040 MOVEI F,IPSF(F) ;ALSO, FXP IS OUT OF WHACK (BEWARE!)
030 PUSH FXP,F
031 MOVE F,(F)
032 209 025 XCT @-1(FXP) ;EXECUTE AN INSTRUCTION
033 CAIA
034 AOS -1(FXP) ;HANDLE SKIPS CORRECTLY
035 AOS -1(FXP)
036 MOVEM F,@(FXP)
037 064 009 SUB FXP,R70+1
038 028 050 HRRZ F,INTPDL
039 028 039 MOVEM R,IPSR(F)
040 028 038 EXCH D,IPSD(F)
041 028 037 POP FXP,IPSPC(F)
042 228 004 JRST IWLOOK ;MAY NEED TO XCT SOME MORE
INTERNAL PCLSR'ING ROUTINES LISP.393[MAC,LSP] 01/17/78 Page 229
001
002 ;;; IFN QIO
003
004 072 013 INTSYP: SOS NPFFY2 .SEE SYCONS
005 023 046 INTSYQ: SOS NPFFY2
006 072 013 INTSYX: MOVEI R,SYCONS
007 226 038 JRST INTBK1
008
009 071 024 INTROT: HLRZ R,R ;PROTECT CODE OF THE FORM
010 071 024 SUBI R,1 ; ROT A,-SEGLOG
011 005 042 ROT A,SEGLOG ; ... MUNCH ...
012 226 038 JRST INTBK1 ; ROT A,SEGLOG
013
014 071 024 INTPPC: HLRZ R,R ;PROTECT PURE CONSER
015 071 024 SUBI R,1 ;BACK UP TO THE AOSL OR WHATEVER
016 028 037 HRRM R,IPSPC(F)
017 071 024 SOS @(R) ;RESTORE THE COUNTER
018 226 039 JRST INTOK
019
020 INTC2X: HLRM B,A ;MUST PROTECT LEFT HALF OF B FOR CONS
021 073 012 MOVEI R,CONS1 ;HAIRY KIND OF BACKUP FOR CONS
022 226 038 JRST INTBK1
023
024 205 028 INTACT: HRRZ R,UUTSV .SEE UUOACL
025 228 004 JRST IWLOOK
026
027 071 024 INTTYX: HLRZ R,R ;ARRANGE TO GO TO INTTYR, WHICH WILL
028 071 024 PUSH P,R ; GET THE TTSAR BACK INTO T, THEN POPJ
029 071 024 MOVEI R,INTTYR .SEE TYOXCT TYIXCT TYICAL
030 020 032 HRRZS INHIBIT .SEE .5LKTOPOPJ
031 226 038 JRST INTBK1
032
033 INTZAX: TDZA A,A ;FOR CONSERS WHICH DON'T WANT TO PROTECT THEIR FREELIST!
034 051 010 INTACX: MOVSS A .SEE ACONS ;(RESTORES A FOR BACKUP)
035 071 024 INTBAK: HLRZ R,R ;BACK UP PC TO BEGINNING
036 028 037 INTBK1: HRRM R,IPSPC(F) ; OF INTERVAL
037 071 024 INTOK: TLZ R,-1
038 071 024 10$ CAIL R,400000 ;NO ARRAYS IN HIGH SEGMENT!
039 229 042 10$ JRST IWWIN
040 071 024 CAML R,@VBPEND
041 224 017 JRST INTSFX
042 028 050 IWWIN: HRRZ F,INTPDL ;WE HAVE WON!
043 POPJ FXP,
044
045 ;;; NEED WE PIOF AROUND THIS JSR UISTAK ?? E.G. WHAT ABOUT MEMERR?
046
047 016 004 IWSTAK: JSR UISTAK ;WE ARE IN A BAD STATE --
048 AOS (FXP) ; STACK UP THE INTERRUPT
049 229 042 JRST IWWIN
050
051 ] ;END OF IFN QIO
052
053 020 015 PGTOP INT,[INTERRUPT AND UUO HANDLERS]
STRUCT INSERT, BIT TABLES, AND SPACE CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 230
001
002
003 SUBTTL STRUCT INSERT, BIT TABLES, AND SPACE CALCULATIONS
004
005 035 069 IFE LOPATCH,[
006 035 066 EXPUNGE PATCH PAT XPATCH
007 002 045 PATCH: PAT: XPATCH: BLOCK PTCSIZ
008 EPATCH==.-1
009 ] ;END OF IFE LOPATCH
010
011 PAGEUP
012 011 045 10$ BSYSSG==HILOC-STDHI ;CROCK - BEWARE RELOCATION!
013 SPCTOP SYS,,[SYSTEM]
014 230 012 10$ EXPUNGE BSYSSG
015 007 033 NPURPG==<.-BPURPG>/PAGSIZ
016
017 10$ $LOSEG
018
019 INUM==.
020
021
022 006 006 $INSRT STRUCT ;INITIAL LIST STRUCTURE
023
024 ;;; 10$ NOW IN ** LOW SEGMENT **
025
026
027
028 NBITB==NIFSSG+NIFXSG+NIFLSG+NBNSG
029 008 004 ZZ==<<NBITB+1>*BTBSIZ+SEGSIZ-1>/SEGSIZ
030 008 011 IFN ZZ-BTSGGS,[
031 035 033 WARN [NEEDED NUMBER OF INITIAL BIT TABLE SEGMENTS (]\ZZ,[) DOESN'T
032 008 011 MATCH GUESS. (BTSGGS=]\BTSGGS,[)
033 ]
034 ] ;END OF IFN ZZ-BTSGGS
035
036 .ALSO .ERR
037
038 035 087 IFN LOBITSG, BFBTBS=BTBLKS+NBITB*BTBSIZ
039 .ELSE,[ ;;; NOTE WELL! FIRST FS SEGMENT GETS FIRST
040 ;;; BIT BLOCK! (SEE NUNMRK, GCP6)
041 SPCBOT BIT
042 008 008 BTBLKS: BLOCK NBITB*BTBSIZ
043 BFBTBS: ;BEGINNING OF FREE BIT BLOCKS
044 PAGEUP
045 036 033 SPCTOP BIT,ST,[BIT BLOCK]
046 ] ;END OF .ELSE
047
048
049 008 009 NBPSSG==1*SGS%PG ;INIT WILL MUNG ST AND PURTBL ANYWAY TO PRESERVE ALLOC
050 008 009 NFXPSG==1*SGS%PG ;PDL AREAS FOR INIT AND ALLOC
051 008 009 NFLPSG==1*SGS%PG
052 008 009 NPSG==1*SGS%PG
053 008 009 NSPSG==1*SGS%PG ;ALLOC ALTERS ALL PDL PARAMETERS!!!
STRUCT INSERT, BIT TABLES, AND SPACE CALCULATIONS LISP.393[MAC,LSP] 01/17/78 Page 230.1
054
055 002 026 IFN ITS,[
056 008 009 NXFXPSG==1*SGS%PG
057 008 009 NXFLPSG==1*SGS%PG
058 008 009 NXPSG==1*SGS%PG
059 008 009 NXSPSG==1*SGS%PG
060
061 008 009 IFN ML+QIO, NSCRSG==2*SGS%PG
062 008 009 .ELSE NSCRSG==3*SGS%PG ;ALLOW FOR PDP6 PAGE (P6)
063
064 ;;; NUMBER OF NON-EXISTENT MEMORY SEGMENTS
065 ;;; (TAKE ALL OF CORE AND SUBTRACT OUT EVERYTHING USEFUL!!!)
066 008 007 NNXMSG==NSEGS
067 036 033 IRP SPC,,[ZER,ST,SYS,SAR,VC,XVC,IS2,SYM,XXA,XXZ,SY2,PFX,PFS,PFL,XXP
068 027 050 IFS,IFX,IFL,BN,XXB,BIT,BPS,FXP,XFXP,FLP,XFLP,P,XP,SP,XSP,SCR]
069 220 022 NNXMSG==NNXMSG-N!SPC!SG
070 TERMIN
071
072 ;;; DETERMINE ORIGINS FOR ALL SPACES ABOVE THIS POINT
073 ZZX==.
074 027 050 IRP SPC,,[BPS,NXM,FXP,XFXP,FLP,XFLP,P,XP,SP,XSP,SCR]
075 034 059 B!SPC!SG==ZZX
076 220 022 ZZX==ZZX+N!SPC!SG*SEGSIZ
077 TERMIN
078
079 008 004 SPDLORG==MEMORY-<NSCRSG+NSPSG+NXSPSG>*SEGSIZ
080 008 004 PDLORG==SPDLORG-<NPSG+NXPSG>*SEGSIZ
081 008 004 FLPORG==PDLORG-<NFLPSG+NXFLPSG>*SEGSIZ
082 008 004 FXPORG==FLPORG-<NFXPSG+NXFXPSG>*SEGSIZ
083
084 ] ;END OF IFN ITS
085
086 002 026 IFE ITS,[
087 ZZX==.
088 IRP SPC,,[FXP,FLP,P,SP,BPS]
089 034 059 B!SPC!SG==ZZX
090 220 022 ZZX==ZZX+N!SPC!SG*SEGSIZ
091 TERMIN
092
093 SPDLORG==BSPSG
094 PDLORG==BPSG
095 FLPORG==BFLPSG
096 FXPORG==BFXPSG
097
098 ] ;END OF IFE ITS
099
100 20$ WARN [SPACE CALCULATIONS?]
APOCALYPSE (END OF THE WORLD) LISP.393[MAC,LSP] 01/17/78 Page 231
001
002 SUBTTL APOCALYPSE (END OF THE WORLD)
003
004
005 ;FOR REL ASSEMBLIES, INIT AND ALLOC CODE OVERLAP INITIAL BPS
006
007 10$ LOC BBPSSG
008
009 006 006 $INSRT ALLOC ;INITIALIZATION AND ALLOCATION ROUTINES
010
011 PRINTX \
012 \ ;JUST TO MAKE LSPTTY LOOK NICER
013
014 034 040 EXPUNGE ZZ ZY ZX ZZX ZZY ZZZ ZZW
015
016 10$ IF2, BSYSSG==400000 ;ANTI-RELOCATION CROCK
017
018 IF2, MACROLOOP NBITMACS,BTMC,* ;FOR BIT TYPEOUT MODE
019
020 CONSTANTS ;FOR ALLOC
021
022 ENDLISP:: ;END OF LISP, BY GEORGE!
023
024 VARIABLES ;NO ONE SHOULD USE VARIABLES!
025
026 231 022 IFN .-ENDLISP, WARN [OKAY, WHO'S THE WISE GUY USING VARIABLES?]
027
028 005 005 IFN D10,[
029 $HISEG
030 ENDHI:: ;END OF HIGH SEGMENT
031 ] ;END OF IFN D10
032
033 END INITIALIZE
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page I
G 018*064 G 186*076 %CAAAR 070 030 .APPLY 158*007 AIPCLO 030*080 APP1 089 035
G 018*065 G 186*078 %CAADA 070*028 .DELET 092 032 AL5AB 135 051 APP2 089 008
G 018*066 G 186*080 %CAADD 070*027 .DELQ 092*031 ALARMC 140*027 APPEND 089*005
G 018*070 G 189*036 %CAADR 070*029 .FUNC1 133 017 ALARMC 140*074 APPLY 158 004
G 018*070 G 192*032 %CAAR 070 016 .FUNC2 133 021 ALCK1 140 051 APTB1 162 002
G 018*071 G 219*058 %CADAA 070*047 .FUNC3 133 033 ALCK1 140 087 AR1RET 089 042
G 018*072 G 219*061 %CADAD 070*046 .FUNC4 133 014 ALCK2 140 100 AR2ARE 091*028
G 018*072 G 220*023 %CADAR 070 014 .GCPR5 095 038 ALCK3 140 083 AREAS = 035*076
G 018*073 G 220*024 %CADDA 070*012 .GCPRO 095*025 ALCK4 140 049 ARG 141*037
G 018*074 G 220*026 %CADDD 070*011 .LCACX 067 050 ALCK4 140 084 ARG3 141 042
G 032*007 G 220*050 %CADDR 070*013 .LCADB 067 045 ALCK5 140 095 ARGCHK 218 003
G 103*034 G 222*017 %CADR 070 015 .LCADX 067 055 ALCK7 140 099 ARGCK0 218 012
G 110*027 G 222*034 %CAR 070*017 .LCAF5 067 020 ALFLP = 008*016 ARGCK1 218 007
G 110*028 $ = 034 043 %CARCD 071 007 .LCAF7 067 035 ALFLP = 008*021 ARGCK2 218 010
G 113*042 $ = 034 046 %CDAAA 070*044 .LCAFL 067 042 ALFXP = 008*015 ARGCK3 218 023
G 113*044 $$$NIL 039 025 %CDAAD 070*043 .LCAFX 067 039 ALFXP = 008*020 ARGCK4 218 017
G 113*044 $AND 165*033 %CDAAR 070 035 .LCALL 067*019 ALGCF 030 049 ARGCK5 218 034
G 113*045 $APPLY = 061 044 %CDADA 070*033 .LOSE M 006 121 ALIST 134 052 ARGCL3 117*055
G 113*045 $BREAK 103 004 %CDADD 070*032 .MAP 102 021 ALPDL = 008*014 ARGCLB 117 054
G 115*096 $BRK0 103 005 %CDADR 070*034 .MAP1 102 027 ALPDL = 008*022 ARGCOM 141 053
G 131*045 $CADR 084*051 %CDAR 070 024 .MLLIT = 002*016 ALPHAL 123*005 ARGET 082*043
G 131*051 $CAR 108 031 %CDDAA 070*041 .NCNC1 089*018 ALPL2 123 028 ARGET1 082*045
G 132*075 $COMME 165*012 %CDDAD 070*040 .NCNC2 089 019 ALPL3 123 012 ARGLCK 218 005
G 144*010 $CONS 073*030 %CDDAR 070 022 .NCNC3 089 026 ALPLP1 123 014 ARGP0 218 040
G 146*046 $ERRFR = 061 004 %CDDDA 070*020 .NCONC 089 015 ALSPDL = 008*017 ARGP1 218*041
G 147*059 $EVALF = 061 005 %CDDDD 070*019 .RSET 068*008 ALSPDL = 008*023 ARGPDL 218 038
G 149*014 $GETCH 121*004 %CDDDR 070*021 .SET 057 006 ALST1 134 053 ARGS 117 004
G 149*015 $INSRT M 006 006 %CDDR 070*023 .SET1 057 007 ALST2 135 004 ARGS0 117 059
G 149*016 $INSRT M 006 017 %CDR 070*025 .STOR0 056 014 ALST3 135 010 ARGS1 117 007
G 149*017 $MAPCA 100 023 %CONS 073 042 .STOR1 056 019 ALST3A 135 015 ARGS1A 117 010
G 149*018 $NCONS 073*029 %CONS1 073 044 .STOR2 056 022 ALST4 135 033 ARGS3 117 027
G 149*019 $NULL 086*010 %CONS3 073 053 .STOR4 056 034 ALST4A 135 034 ARGS5 117 037
G 149*023 $OR 165*034 %CXR 076*008 .STOR4 056 051 ALST4C 135 040 ARGS6 117 045
G 149*024 $PNG.D 138 054 %CXR 077*006 .STORE 056 009 ALST5 135 041 ARGSC1 117 019
G 149*025 $PNG.R 138 041 %CXR2 077 012 .UDT4 052*020 ALST5A 135 048 ARGSCU 117*012
G 149*026 $PNG3 138 044 %GCPRO 095*007 ABBRSW 021 046 ALST6 136 007 ARGXX 141*038
G 149*027 $PNG3A 138 046 %HISEG = 011*023 ABIND3 014 010 ALST6A 136 008 ARPGCT 024*074
G 149*029 $PNG4 138*048 %HNK4A 077 034 AC 065 012 ALST6B 136 014 ARYGET 014*024
G 149*030 $PNGET 138*032 %HUNK3 076*006 AC 065 016 ALST7 136 004 ARYGT4 014 026
G 149*032 $PNGX 138 060 %HUNK3 077*032 ACLKTY 030 073 ALST7A 136 016 ARYGT8 014 030
G 149*034 $RUNTI 086*040 %HUNK4 076*007 ACONS 051 010 ALTP 179*053 ASSOC 081 041
G 179*022 $SLEEP 140*006 %HUNK4 077*036 ADDSAR 032*016 ANDOR 165 036 ASSQ 081 042
G 179*026 $UIFRA = 061 007 %LOSEG = 011*022 ADYGET 014*042 ANYGET 014*035 AT.CHS 018 056
G 184*062 $XCONS 073*031 %LSUBR 159*018 AEVAL 133 040 AP2 158 022 AT.CHS 019 041
G 184*062 $XLOSE 184 065 %NCONS 073*040 AEXP 155 010 AP3 158 008 AT.LNN 018 057
G 186*064 $XLOST 184 062 %RPX 076*009 AFILRD 030 050 AP3A 158 016 AT.LNN 019 042
G 186*066 %%FUNC 133*006 %RPX 077*019 AFPOPJ 061 036 AP4 158 029 AT.PGN 018*058
G 186*068 %ARR7 160*008 %RPX2 077 025 AGDBT 022*039 APFNG 137 013 AT.PGN 019*043
G 186*070 %ARRAY 160*003 %SYMBO 093*018 AHSH1 097 010 APFNG1 021 019 ATAN.S 020*060
G 186*072 %CAAAA 070*038 %XCONS 073*041 AHSH2 097 015 APLBL 137 033 ATAN.X 020*068
G 186*074 %CAAAD 070*037 .APPEN 089 030 AINT 030 074 APLBL1 137 045 ATAN.Y 020*072
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page II
ATMBF = 022*022 BOUNDP 086*026 CATID 020 041 CKI4A 201 058 CPDLNK 094*031 CRSRP9 131 049
ATMHSH 097 007 BPPNR 032*013 CATPS1 054 005 CLIINT 191 008 CPJSW 032*030 CRSRP9 132 073
ATO.LC 019 040 BPSH 027 004 CATPUS 054 004 CLZDIS 016 038 CPOP1J 059 041 CRSRPS 132 009
ATOM 080 005 BPSL 027 008 CATRTN 020 029 CMAPL3 101 048 CPOPAJ 059 036 CRSUBR 071 019
ATTSV 030 075 BPURPG = 039 024 CAUNBI 137 024 CMAPL6 101 007 CPOPBJ 050*032 CSET0 084 025
AUNBD 020 058 BREAK 174 030 CB 103*051 CMPL1 075 025 CPOPCJ 059*045 CSET0A 084 031
AUNBF 021 022 BRETJ 084 033 CBIND4 050 024 CMPL1 075 039 CPOPJ 059 031 CSET0C 084 018
AUNBIN 136 028 BRGEN 055 011 CBKCM0 103 110 CMU = 002 031 CPOPNV 060*056 CSET0Q 084 024
AUNBN0 136 029 BRLP 055 035 CCMPL1 064 005 CN.34 204 007 CPOPXJ 060 009 CSET2 084 042
AUNBN1 136 037 BRLP1 055 022 CCPOPJ 059 027 CN.A 204 004 CPSY 124 008 CSET2A 084*045
AUNBN2 136 040 BRLP2 055 043 CDBL1 064 006 CN.AT 204 014 CPSY0 124 011 CSET4 084 056
AUNBN3 136 047 BRLP3 055*050 CDUPL1 064 004 CN.B 204*011 CPSYMX 143 038 CSET4A 084 059
AUNBN4 136 053 BRLP4 055 046 CEVAL 043*021 CN.BB 103*055 CPXDFL 059 052 CSET4C 085 024
AUNBN5 136 054 BSYSSG = 230 012 CFAIL 021*029 CN.E 203 005 CPXDJ 059*058 CSET7 084 037
AUNBN6 136 059 BSYSSG = 231 016 CFIX1 064 007 CN.G 189 050 CPXTJ 072 057 CSETZ 043*027
AUNBN7 136 060 BTB. = 038*007 CFLOAT 064 008 CN.G 203 029 CQFUNC 166 074 CSUCE 021*030
AUNBR 021 014 BTBAOB 026*024 CHECKA 069 048 CN.G0 203 030 CR0 071 056 CTRLG 189*040
AUTOLO 129 031 BTBLKS 035 087 CHECKI 066 021 CN.G1 189 061 CR1 071 061 CTRLG 203*024
AYNVSF 014*020 BTBLKS 230 042 CHECKQ 069 022 CN.G1 203 042 CR1A 071*062 CTRUE 125 046
AZYGET 014*053 BTBSIZ = 008 008 CHECKU 069 018 CN.G2 203 037 CR2 071 064 CUNBIN 164 094
BACTYF 021*035 BTSGGS = 008 011 CHECKZ 069 050 CN.G3 203 054 CR3 071 066 CURBLK 031*018
BAPOPJ 059*020 BTSGGS = 230 032 CHKHGH 033 115 CN.H 204 010 CR4 071 075 CURSOR 131 006
BB = 145*035 BTSGLK 026*017 CHNI1H 186*028 CN.HB 103*054 CR5 071 083 CURSOR 132 005
BFBTBS 230 043 BUFFER 031 019 CHNI2 186 082 CN.O 203 012 CR5M1P 060 025 CURSTD = 011*046
BFBTBS = 230 038 BVDC = 010 021 CHNI4 187 004 CN.W 189 024 CR6 071 090 CURSTD = 011*051
BFBTBS ← 026 025 BZERSG = 011 054 CHNI4A 187 006 CN.W 203 016 CR7 071 072 CXCONS 075 027
BFPRDP 020 035 BZERSG = 011 055 CHNI4C 187 027 CN.X 189 049 CRETJ 091 050 CXCONS 075 038
BFTMPS 029 014 C 035 006 CHNI4H 187 031 CN.X 203 028 CRINTE 107 015 CXCONX 075*023
BGNMAK 051*023 C$CAR 108*032 CHNI5 187 014 CN.Z 177 054 CRSR10 132*017 CXFLAG = 002 069
BIGNUM = 002 041 C1CONS 051*005 CHNI8 187 021 CN.Z 179 050 CRSR11 132 081 CXNV1 065 048
BIND 050 010 C2 027 061 CHNINT 186 009 CN.Z 189 034 CRSR12 132 093 CXNV1X 065 045
BIND1 050 026 CALL ← 205 008 CHNTB 017 019 CNOT 086*012 CRSR13 132 096 CXR 076 015
BIND4 050 018 CARCDR 070*010 CHNV1 107 050 CNSGT1 221 041 CRSR14 132 099 CXR2 076 024
BIND5 050 023 CASE 173*003 CHNV1A 107 060 CNTBL 202 017 CRSR20 132 041 CXR3 076 052
BKCOM 103 088 CASE1 173 025 CHNV1B 107 062 CNTRL1 202 007 CRSR40 132 058 CXR30 076 044
BKCOM0 103 099 CASE1A 173 047 CHNV1C 107 064 CNTROL 016 014 CRSRM1 132 119 CXR31 076 049
BKCOM1 103*114 CASE1B 173*040 CHNV1D 107 054 CON2 171*021 CRSRMP 132 118 CXR33 076 061
BKCOM2 103 102 CASE1C 173 083 CHNV1X 107*049 CON3 171*011 CRSRN 132 132 CXR34 076 064
BKERST 171 024 CASE1D 173 038 CIAPPL 155*014 COND 171 005 CRSRP0 132 027 CXSGLK 026 008
BKRST0 171 033 CASE1E 173 028 CILIST 214 019 COND = 005 017 CRSRP1 131 057 D ← 181 046
BKRST1 171 041 CASE1G 173 056 CIN0 059 004 COND1 171 004 CRSRP1 132 103 D ← 183 029
BKRST2 171 037 CASE1H 173 031 CINTRE 066*018 COND2 171 015 CRSRP3 131 031 D ← 183 042
BKRST3 171 029 CASE1Q 173 062 CKI0 201 002 CONS 073 010 CRSRP3 132 053 D ← 183 065
BKRST4 171 032 CASEAQ 173 080 CKI1 201 069 CONS1 073 012 CRSRP4 131 036 D10 = 005 005
BKTRP 021*005 CASEBQ 173 068 CKI1A 201 081 CONS1F 059*016 CRSRP4 132 063 D10ARD 030*018
BNCONS 051*024 CASEE 173 007 CKI2 201 008 CONS1P 059*015 CRSRP5 131 019 D10NAM 030 020
BNHSH 097 008 CASEF 173 021 CKI2A 201 009 CONS3 073 021 CRSRP5 132 043 D10PTR 030*017
BNMSV 022*036 CASEM 173 074 CKI2F 201 019 CONSFX 059 018 CRSRP6 131 037 D10REN 030*021
BNSGLK 026*010 CASEQ 173*002 CKI2F1 201 028 CONSIT 059*019 CRSRP6 132 064 D20 = 005 006
BOOLI 021*036 CASES 173 024 CKI2I 201 099 CONSPF 059*017 CRSRP7 131 027 DBCONS 075*005
BOTN = 011*007 CATCH 172*042 CKI3 201 036 COPYSY 124*004 CRSRP7 132 050 DBCONS 075*016
BOUND1 082 016 CATHRO 172 060 CKI3B 201 045 CORBP 021*066 CRSRP8 132 021 DBFLAG = 002 068
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page III
DBGMS2 = 181*034 DO5G 170 007 EPATCH = 035*068 ERP4 219 055 EVTB1 153 037 FFY 023 021
DBGMSK = 009 048 DO5Q 169*022 EPATCH = 230*008 ERP5 219 035 EVTB2 153 052 FFY2 023 025
DBGMSK = 181 028 DO6 170 014 EPC1 057 064 ERP5A 219 036 EXAMIN 139*012 FFZ 023 019
DBL1 075 003 DO6A 170 019 EPFFB 023*056 ERP6 219 064 EXP.S 020*059 FI.BBC 018*013
DBL1 075 017 DO6C 170 026 EPFFC 023*054 ERP6A 219 067 EXP3 155 012 FI.BBF 018*014
DBNV1 065 036 DO7 168 035 EPFFD 023*053 ERR 172 020 EXPL5 021 002 FI.EOF 018*012
DBSGLK 026 007 DO7A 168*038 EPFFH 023*058 ERR0 054 033 F.CHAN 018 019 FIRSTL 011 033
DD1 022*030 DO8 169 002 EPFFL 023*052 ERR1 057 053 F.CHAN 019 017 FIX1 074 006
DD2 022*031 DO9 168 041 EPFFS 023 050 ERR1A 057 052 F.DEV 018*026 FIX1A 074 008
DD3 022*032 DP = 145*036 EPFFX 023*051 ERR3 172 036 F.DEV 018*038 FIX2 074*005
DDL 022*033 DPAGEL 017*034 EPFFY2 023 061 ERR3A 172 031 F.DEV 019*024 FIX7 210*043
DECLAR 165*009 DSAVE 022*042 EPFFZ 023*055 ERRC = 010 007 F.DEV 019*036 FLAT1 021*007
DEF1 108 023 DSIC = 010*014 EPOPJ 054 060 ERRIOJ = 205 024 F.FLEN 018*022 FLC2 027 062
DEF1B 108 024 DUPL1 075 045 EQ 175*020 ERRNX 172*017 F.FLEN 019*020 FLCONS 074 030
DEF3 109 049 DUPL1 075 062 EQLBIG 088 072 ERROR 022 059 F.FN1 018*029 FLCONX 074*025
DEF3A 109 071 DVS1 022*027 EQLHN1 088 091 ERROR3 022*052 F.FN1 019*027 FLNV1 065 029
DEF5 109 098 DVS2 022*028 EQLHN2 088 105 ERROR4 022*054 F.FN2 018*032 FLNV1X 065 026
DEF6 109 084 DVSL 022*029 EQLHNK 088 082 ERRP4 166*072 F.FN2 019*030 FLOAT1 074 028
DEF7 109 039 DXCONS 075*047 EQLLST 088 028 ERRPOP 049 002 F.FPOS 018*023 FLOAT2 074*027
DEF9 108 029 DXCONS 075*061 EQLNM2 088 061 ERRSET 172*002 F.FPOS 019*021 FLOV9A 032*028
DEFAUL = 004 071 DXFLAG = 005 046 EQLNM4 088 052 ERRST3 172 012 F.JFN 018*020 FLOV9B 032*029
DEFAUL = 004 074 DXNV1 065 058 EQLNUM 088 065 ERRSVD 015*034 F.JFN 019*018 FLPORG = 230 081
DEFPRO 108*011 DXSGLK 026 009 EQLOSE 088 068 ERRSW 020 033 F.MODE 018 018 FLPORG = 230 095
DEFUN 109*029 EAL 154 026 EQLP 020 064 ERRTN 020 028 F.MODE 019 016 FLSGLK 026*006
DELC = 010*027 EAL2 154 029 EQLTBL 088 038 ERSETU 066*029 F.PPN 018*028 FLTSFL 062 035
DELETE 092*003 EAR 155 040 EQUAL 088 004 ERSTP 057 038 F.PPN 019*026 FLTSFX 062 031
DELQ 092 002 EAR1 155 051 EQUAL0 088 010 ERUN0 057 046 F.RDEV 018*035 FLTSK1 062 005
DEPOSI 139*005 EAR3 155*044 EQUAL1 088 012 ERUNDO 054*031 F.RDEV 019*033 FLTSK2 062 008
DEPURE 142 005 ECXNV1 065 047 ERBDF 022 061 ESAR 155 039 F.SNM 018 027 FLTSKP 062 010
DF1 = 181 049 EDBNV1 065 035 ERBPLO = 219 023 ESB 156 002 F.SNM 019 025 FLTSTB 062 016
DFPR1 108 039 EDEX2 031*006 ERBPLO = 219 025 ESB1 156 010 FACB 103*087 FLUSHE M 006 032
DFPR2 108 034 EDFLAG = 002 042 ERIN5A 047 028 ESB2 156 005 FACD 022*038 FNYINT 190 030
DISC = 010*022 EDPRFL 031 004 ERIN5B 047 031 ESB3 156 016 FACF 022*037 FO.EOP 019 012
DISLEE 016*041 EDPRN 031*005 ERIN5C 047 012 ESB3A 156 019 FAKDDT 033 170 FO.LNL 019*044
DISLP2 016*043 EDXNV1 065*057 ERIN5D 047 025 ESB3C 156 026 FAKFXP 015 053 FO.PGL 019*045
DLINEL 017*035 EE1 154 002 ERIN6A 047 047 ESB4 156 004 FAKP 015 052 FO.RPL 019*046
DLT1 092 028 EE1A 157 022 ERIN8G 046*051 ETT 154 017 FALSE 081 044 FOO = 004 056
DLT2 092 016 EE2 154 007 ERINI0 046 054 ETVCFL 023 066 FB.BUF 018 062 FOO = 004 057
DLT3 092 013 EE2A 154 008 ERINI2 047*004 EUINT0 200*072 FCN.B 143 058 FORTY 012 021
DLTC 021 015 EFLNV1 065 028 ERINI3 047 053 EV0 153 006 FCN.H 143 057 FPCONS 074*031
DO 168 004 EFM 154 038 ERINI5 047 007 EV0A 153 010 FF = 008 044 FPTEM 020 062
DO2 169 008 EFMER 154*039 ERINI6 047 037 EV0B 021 006 FF = 008 045 FPURF2 147*012
DO4 168 022 EFS 155 017 ERINI8 046 037 EV2 153 049 FF = 008 047 FRETR1 120 013
DO4A 168 017 EFVCS 023 063 ERINIT 046 006 EV3 156 031 FFA 023 023 FRETUR 120 002
DO4C 168*024 EFX 155 002 ERINIX 046 013 EV4 156 039 FFB 023 020 FRM2A 118 006
DO4D 169 013 ELSB 155 021 ERP0A 219 021 EV4B 156*040 FFC 023 018 FRM2B 118 063
DO5 169 018 ELSB1 155 029 ERP0C 219 044 EVAL 152 043 FFD 023 017 FRM3 118*011
DO5B 169 042 ENDFUN = 219 074 ERP0D 219 040 EVAL0 152 052 FFH 023 022 FRM3A 118 019
DO5C 170 009 ENDHI 231 030 ERP0E 219 016 EVALFR 118*004 FFL 023 016 FRM4 118*022
DO5D 170 003 ENDLIS 231 022 ERP0F 219 017 EVALHO 152*008 FFS 023 014 FRM4A 118 021
DO5E 170 002 ENOINT 069 078 ERP1 219 028 EVNH0 152 026 FFVC 023 065 FRM5 118 039
DO5F 169 035 EOFRTN 020 030 ERP3 219 052 EVSYM 157 015 FFX 023 015 FRM5A 118 040
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page IV
FRM7 118 044 GCLOOK 096 009 GETL 083*003 HH = 145*034 IB.DEB = 009*026 INT0 179 007
FRM8 118 049 GCMKL 024*008 GETL0 083 018 HHCTB 196*037 IB.DMP = 009*041 INT1 177 020
FRP1 120 022 GCMRKV 024*068 GETL1 083 020 HILOC = 011 036 IB.DOW = 009*039 INT2 177*027
FRP2 120 029 GCNASV 024 061 GETL3 083*025 HILOC = 039 004 IB.FLO = 009*019 INT3 177 039
FRP2A 120 031 GCOB 103*081 GETL4 083 024 HINUM = 007*023 IB.ILA = 009*036 INT4 177 035
FRP3 120 036 GCP = 024*062 GETL5 083 013 HINXM 027 011 IB.ILO = 009 040 INTACT 226 027
FRP3QA 120 040 GCPR1 095 008 GETLA 083*007 HIXM 027*014 IB.IOC = 009 037 INTACT 229 024
FSAVE 022*044 GCPR2 095 021 GETLE2 083 002 HNKLOG = 002 050 IB.LTP = 009*030 INTACX 226 036
FSLHED 035*059 GCPR3 095 061 GETMAC 126 059 HNKLOG = 005 043 IB.MAR = 009*031 INTACX 229 034
FSSGLK 026 004 GCPR4 095 062 GFLSIZ 025*048 HNKSZ0 078 004 IB.MPV = 009 032 INTAR 028 010
FT.CNS 018 016 GCPRO 095*004 GFSSIZ 025 046 HNKSZ1 078 008 IB.MPV = 009 053 INTBAK 226*037
FT.CNS 019 014 GCREL 096 008 GFXSIZ 025*047 HNKSZ3 078 018 IB.PAR = 009 018 INTBAK 229*035
FTVC = 010*024 GCRL1 096 002 GHNSIZ 025*054 HNSGLK 026 012 IB.PCP = 009*021 INTBK1 226 038
FTVO 031*015 GCRMV 024*073 GLSLUZ 033 105 HUNK 079 036 IB.PDL = 009 029 INTBK1 229 036
FUMBLE M 008 029 GCRSR 016*023 GLSLZ0 033 137 HUNK53 079 041 IB.PDL = 009 052 INTC2X 226 023
FUNAFL = 002 046 GCSP = 024*065 GLSLZ1 033 146 HUNKF0 079 060 IB.PUR = 009 020 INTC2X 229 020
FUNCA1 160*023 GCST 038 002 GLSLZ2 033*150 HUNKF2 079 067 IB.RVI = 009*027 INTERN 104 004
FUNCAL 160*021 GCTIM 024 069 GLSLZ3 033 154 HUNKF3 079 069 IB.SCL = 009*033 INTEX 177 049
FUNCTI 165*002 GCTM1 024*070 GLSLZ4 033 130 HUNKP 078*029 IB.SYS = 009*022 INTEX1 177 051
FWCONS 074 015 GCTWA 123*061 GNUM 030 052 HUNKSI 078 006 IB.TIM = 009 017 INTFLG 015 012
FWNAC1 057 023 GCTWI 123 066 GO 167*002 IAP2 163 010 IB.TTY = 009 045 INTGRP M 181 037
FWNACK 057 021 GCTWX 123 067 GO1 167 007 IAP3 164 070 IB.VAL = 009*038 INTLOS 183 036
FXC2 027 063 GCUUSV 024*071 GO2 167*005 IAP4 164 097 IF 173 087 INTLS1 183 037
FXCONS 074 007 GCWHO 024*052 GO3 167 031 IAP4A 137 004 IFIX 064 022 INTLS9 183 040
FXNV1 065 007 GCWHO1 024*055 GO3A 167 039 IAP5 164 014 IFLOAT 064 031 INTOK 226 039
FXNV2 065 007 GCWHO2 024*056 GO3B 167 033 IAP5B 164 024 IFLT1 064 036 INTOK 229 037
FXNV3 065 007 GCWHO3 024*057 GOBRK 054*047 IAP5C 164 017 IFLT2 064*039 INTPDL 028 050
FXNV4 065*007 GCXSIZ 025*050 GRCTI 126 026 IAPAR1 162 063 IFLT3 064 049 INTPPC 226*017
FXPORG = 230 082 GDBSIZ 025*049 GRESS0 021*025 IAPARR 162 052 IFLT4 064 043 INTPPC 229*014
FXPORG = 230 096 GDXSIZ 025*051 GRESS0 021*028 IAPAT2 162 016 IFLT5 064 033 INTREL 066 020
FXSGLK 026*005 GENSY0 090*005 GRUMBL M 008 033 IAPAT3 162 017 IFLT9 020 063 INTRN 104 011
GAMNT 032*014 GENSY1 090 021 GSASIZ 025*055 IAPATM 162 013 IFPIR = 181 055 INTRN1 104 007
GBNSIZ 025*052 GENSY2 090 007 GSBPN 032*015 IAPIA1 162 037 IFPIR = 181 056 INTRN2 106*015
GC98 026*028 GENSY3 090 016 GSYSIZ 025*053 IAPIAL 162 034 IIAL 162 046 INTRN3 104*005
GC99 026*029 GENSY4 090 006 GTCTB 121 027 IAPLMB 164 002 ILIST 068 038 INTRN4 104*014
GCACSA 024 060 GENSY5 090 037 GTP4A 119 038 IAPLSB 163 005 ILIST1 068 043 INTROT 226 009
GCB = 037 032 GENSY6 090 029 GTPDL2 119 023 IAPPLY 161 015 ILIST3 068*046 INTROT 229 009
GCBCAR = 037 030 GENSY7 090*023 GTPDL3 119 029 IAPSAR 162 051 ILOPER 184 038 INTSFX 224 017
GCBCDR = 037 029 GENSYM 090*004 GTPDL4 119 037 IAPSB1 162 060 ILP1 161 017 INTSFX 227 025
GCBCDR ← 037 030 GET 082*004 GTPDL5 119 012 IAPSBR 162 058 ILP1B 161 037 INTSV 020 018
GCBFOO = 037 034 GET0 082 027 GTPDLP 119 002 IAPXPR 163 002 IMASK 015 046 INTSYP 226 004
GCBFOO = 037 039 GET1 082 029 GTPX0 119 047 IATT 162 025 IMASK2 015 047 INTSYP 229 004
GCBMRK = 037 028 GET3 082 020 GTPX1 119 048 IB.1PR = 009*034 IMPLOD 107*003 INTSYQ 226 005
GCD.A 020*051 GETCH1 121 011 GTRDT8 068 067 IB.42B = 009*043 IMSGLK 026*018 INTSYQ 229 005
GCD.B 020*057 GETCH2 121 014 GTRDTB 068 059 IB.ALA = 009 016 IMXC = 010*019 INTSYX 226 006
GCD.C 020*067 GETCH3 121 017 GWDCNT 020*069 IB.ARO = 009*042 INHIBI 020 032 INTSYX 229 006
GCD.D 020*071 GETCH4 121 020 GWDORG 020*073 IB.AT1 = 009*025 INSERT 006 008 INTTYI 226*031
GCD.UH 021*004 GETCH8 121 023 GWDRG1 020*075 IB.AT2 = 009*024 INSERT 006 019 INTTYX 229*027
GCD.VH 021*011 GETCHA 121*006 HACENT 040 034 IB.AT3 = 009*023 INSIST M 005 010 INTVEC 181 046
GCFLP = 024*063 GETHG1 033 049 HALT M 006 115 IB.BRE = 009*035 INSP 032*019 INTW0 224 005
GCFXP = 024 064 GETHG1 033 096 HBPEND 027*017 IB.C.Z = 009*044 INT 020 015 INTW1 225 024
GCLB 103*075 GETHGH 033 037 HBPORG 027*016 IB.CLI = 009*028 INT0 177 016 INTW2 226 044
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page V
INTW3 204 021 ITS = 002 026 LDSCRU 033 213 LPNBUF = 022 013 MAP 100 020 MKNCH 021*068
INTW4 226 046 IUSN 030 002 LDTEMP 029*020 LPNBUF = 022 014 MAPAT1 099 019 MKNM1 107 018
INTW5 226 054 IWAIT 227 015 LDXBLT 029 028 LPNF 021 012 MAPAT2 099 027 MKNM1 107 029
INTWAI 016 008 IWLOOK 228 004 LDXDIF 029*031 LPROGZ = 047 097 MAPAT9 099 035 MKNM2 107*023
INTXCT 225*035 IWSTAK 229 047 LDXSIZ 029 029 LPRP = 166 019 MAPATO 099*009 MKNM4 107 041
INTXCT 228*026 IWWIN 229 042 LDXSM1 029*030 LPSMTB = 145 015 MAPC 100*021 MKRL1 107*031
INTXIT 182 031 JCLBF = 022 021 LEP1 = 020 042 LPTC = 010 013 MAPCAR 100*019 ML = 002 038
INTXIT 183 012 JCLSET 222 008 LERSTP = 057 043 LR70 = 064 002 MAPCON 100*022 MNMX0 021*024
INTXT2 183 024 JCST1 222 038 LFAKFX = 015 051 LRBLOC = 030 059 MAPL0 100 024 MOBIOF = 002 039
INTXT9 183 027 JCST2 222 025 LFAKP = 015 050 LRBLOC = 030 063 MAPL1 100 040 MOBIOF = 005 028
INTZAX 226 035 JCST3 222 041 LFTMPS = 029*035 LRCT = 007 017 MAPL1B 100 055 MOBIOF = 005 029
INTZAX 229 033 JCST4 222 015 LFY1 138 018 LRCT = 007 018 MAPL2 101 025 MOBIOF = 005 031
INUM = 230*019 JCST5 222 034 LFY3 138 013 LSJCLB = 033 172 MAPL21 101 028 MPVERR 184 034
IOBAR1 034*019 JLIST 068 035 LHFLAG = 002 065 LSPRET 040 025 MAPL22 101 051 MUNGP 029 009
IOBAR2 034 022 JOBINT 188 010 LHFLAG = 005 035 LSPRT1 040 027 MAPL23 101 056 MUNKAM 139*020
IOC 129 006 JOBQIO = 002 049 LHSGLK 026*021 LSWS = 022 070 MAPL24 101 058 MUTXOR M 004 062
IOC1 129 010 JOBQIO = 005 033 LIHAC 220*162 LTYOC 032*005 MAPL3 101 002 MXIPDL = 028 043
IOC2 129 017 JOBQIO = 005 034 LINMDP 044 015 LUINF = 197 038 MAPL3A 101 008 N 220 022
IOCER8 185 030 JOBTB 017 039 LINMOD 030 043 LUNREA = 028 015 MAPL4 101 041 N0.0PU = 039 021
IOCERR 185 006 JPCSAV 012 037 LINTAR = 028 007 LUNREA = 028 016 MAPL40 101 039 N0PUSH = 039 020
IODF1 032*007 JRST V 209 011 LINTAR = 028 008 LUUSV = 022 069 MAPL5 102 002 N2DIF = 011*014
IOG 129*019 JRST V 212 032 LINTPD = 028 049 LVLRTS = 022 048 MAPL5A 102 006 NAM = 037 038
IOGBND 054 054 KA10 = 002 034 LINTVE = 181 063 LVRNO = 004 006 MAPL6 101 010 NARITH = 002 070
IOLB 103*084 KA10 = 005 038 LIOBUF = 007*019 LVRNO = 004 008 MAPL6A 101 018 NBITB = 230 028
IOST 021*033 KI10 = 002 035 LIPSAV = 028 032 LVRNO ← 004 008 MAPL7 101 019 NBLOKS 031*024
IPCLOK 020 016 KI10 = 005 039 LISP 220 009 LWNACK 057 027 MAPL7A 101 020 NBPSSG = 230*049
IPLC = 010*016 KILHG1 033 016 LISP1 040 044 LXXBSG = 038*028 MAPL8 102 016 NCONC 089*004
IPLM4A 164 044 KILHG1 033 029 LISP17 220 027 M1TTPJ 059 043 MAPLIS 100 018 NCONS 073 008
IPLMB1 164 012 KILHG2 033 034 LISP2 040 047 M30. 140 103 MARINT 191 023 NEWRD = 002 047
IPLMB2 164 031 KILHGH 033 007 LISP2A 040 057 M6. 140 068 MAXNXM 027*015 NFF = 023 024
IPLMB4 164 042 KL10 = 002 036 LISP43 221 004 MACOUT 022 018 MEMB1 091 019 NFFA 024*048
IPLMB5 164 053 KL10 = 005 040 LISPGO 039 037 MAINBI 026*027 MEMB2 091 029 NFFB 024*045
IPRIN1 044 056 KLIST 068*032 LISPSW 011 065 MAK1 105 023 MEMBER 091 004 NFFC 024*043
IPROGN 164 066 LAST 086 015 LIST 068 019 MAK2 104 043 MEMER5 184 040 NFFD 024*042
IPSD = 028 038 LAST1 086 017 LISTEN 140*109 MAK3 104 056 MEMER7 184 051 NFFH 024*047
IPSDF1 = 028 035 LAST2 086 022 LISTIF 138*004 MAK4 104 052 MEMER8 184 054 NFFL 024*041
IPSDF2 = 028 036 LATOM 080 012 LISTX 068 020 MAKA 105 008 MEMERR 184 007 NFFS 024 039
IPSF = 028 040 LCHNTB = 017 016 LISTX3 068 022 MAKA0 105 007 MEMORY = 007 032 NFFX 024*040
IPSPC = 028 037 LCHNTB = 017 017 LJCLBF = 022*049 MAKA2 105 012 MEMQ 092 038 NFFY 024*046
IPSR = 028 039 LD6BIT 029*021 LJOBTB = 017 038 MAKA3 105 002 MEMQ2 091 010 NFFZ 024*044
IPSWD1 = 028 033 LDAAOB 029*019 LLIP1 032*018 MAKA4 105 022 MEMV 021 008 NFLPSG = 230 051
IPSWD2 = 028 034 LDAPTR 029*023 LMBLP 164 058 MAKA5 105 017 MFFA 024*034 NFTVBL 031*020
IPUR1 147 022 LDASAR 029*026 LMBLP1 164*061 MAKF 104 033 MFFB 024*031 NFVCP 023*064
IPUR2 147 045 LDBPTR 029*024 LMBLP2 164 063 MAKF1 104*039 MFFC 024*029 NFXPSG = 230 050
IPUR3 148 011 LDBSAR 029*027 LOBITS = 035 080 MAKHUN 079 005 MFFD 024*028 NHBTSG = 034*050
IPUR3A 148 008 LDBYTS 029*017 LOBITS = 035 090 MAKNAM 107*004 MFFH 024*033 NHBTSG = 034*052
IPUR4 148 027 LDEOFJ 029*033 LONBFA 018*060 MAKNUM 139 017 MFFL 024*027 NILBAD 043 024
IPUR5 148 038 LDEOFP 029*034 LONBFA 019*048 MAKVC 050 034 MFFS 024 025 NILHSH 097 018
IPUR6 148 061 LDF2DP 029*025 LONUM = 007*022 MAKVC0 050*036 MFFX 024*026 NIOBFS = 002 066
IPUR6A 148 059 LDHLOC 029*032 LOPATC = 035 069 MAKVC1 050 042 MFFY 024*032 NIOBFS = 005 036
IPUR7 148 070 LDOFST 029*018 LOPATC = 035 074 MAKVC3 050 048 MFFZ 024*030 NIOCTR = 011 011
IRMVF 024 072 LDRIHS 033 181 LOSEF 032 024 MAKVCX 050*044 MFTVBL 031*021 NJCALF ← 206*004
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page VI
NLBTSG = 034*049 NPSG = 230 052 OLINEL 032 048 PEEK 112 024 POP1J 059 040 PS2SIZ 026*045
NLBTSG = 034*051 NPURPG = 230 015 OMXC = 010*020 PFLSIZ 026*036 POP1J1 059*038 PSGDEV 039 007
NMCK0 094*002 NPURTR = 011 010 OPD 035 008 PFSSIZ 026 034 POP2J 059 030 PSGEXT 039 008
NMK1 094 023 NPUSH 066 009 OPNWRD M 035 005 PFXSIZ 026*035 POPAJ 059 035 PSGNAM 039 006
NMSKBG 062 030 NRD10F 022*045 OSASIZ 025*041 PG0 166 014 POPAJ1 059*033 PSGPPN 039 009
NMSKCX 063 043 NRECON 089 056 OSC2 027*074 PG0A 166*031 POPBJ 050 031 PSMRS 032 038
NMSKDB 063 040 NREV1 089 057 OSYSIZ 025*039 PG1 166 023 POPCJ 059 044 PSMS 032 035
NMSKDB 063 045 NREVER 089 055 OTYIC 221 051 PG1A 166 024 POPJ1 059 039 PSMST 145 017
NMSKFL 063 037 NSCRSG = 230 061 OTYOC 221 055 PG5 167 009 POPNCO 079 057 PSMTB 145 006
NMSKFX 063 034 NSCRSG = 230 062 P% = 145 026 PG5A 167 024 POPNVJ 059 026 PSMTS 032 037
NMSKIP 063*015 NSEGS = 008 007 P%OFF 142 016 PHNSIZ 026*042 POPXDJ 059 057 PSVC1 144 033
NMSKP2 063 014 NSFC = 013 011 P. = 145*024 PIHOLD 177 014 POPXTJ 060 050 PSVC2 144 036
NMSKTB 063 021 NSFC = 013 018 P6 = 010*038 PINBL 177*013 POV2 032*004 PSVC3 144 045
NNPUSH = 039 019 NSFC = 013 038 PA4 020 031 PIRQC = 181 049 PPGI2 193 017 PSYM 142 013
NNUMTP = 007 038 NSPSG = 230 053 PAERR 218 047 PIRQC = 181 050 PPGI3 193 014 PSYM1 142 020
NNXMSG = 230 066 NTYPES = 007 039 PAGKSM = 007*035 PIRQC = 181 051 PPGI3 194 014 PSYMF 032 032
NNXMSG = 230 069 NUINT0 = 195*042 PAGLOG = 007 028 PIRQC = 181 052 PPGI5 193 020 PSYMP 143 028
NOFCH = 010*029 NUINT0 = 195*043 PAGLOG = 007 029 PIRQC = 181 053 PPGI5 194 017 PSYMP1 143 041
NOFCH = 010*030 NUINT1 = 195*051 PAGMSK = 007 034 PIRQC = 181 054 PPGI6 193*029 PSYMQ 143 029
NOFCH = 010*031 NUINT2 = 195*061 PAGMSK V 007 035 PIRQC = 181 059 PPGI6 194*026 PSYMSB 143 053
NOINT 177*036 NUMCHK 094 003 PAGPUR = 145*033 PIRQC = 181 060 PPNAT2 053 016 PSYMT 145 046
NOINT 179*014 NUMP 093 005 PAGSIZ = 007 033 PIRQC = 181 061 PPNAT3 053 048 PSYMT1 145 052
NOINT0 069 009 NVCFL 031*031 PANICP 024 067 PL. = 145*025 PPNAT4 053 027 PSYMT2 145 062
NOINT1 069 025 NVDC = 010*018 PARERR 184 039 PLIST 080*021 PPNAT5 053*051 PSYMT3 145 066
NOINT2 069 070 NVDCL 031*030 PAT 230 007 PLSYM 142 012 PPNAT6 053 041 PSYMTL = 145 079
NOINT3 069*031 NVDK 031*032 PATCH 035 066 PLTLST 031*037 PPNAT9 053 047 PSYMTT 145 075
NOINT4 069 041 NVSCL 031*014 PATCH 230 007 PLTTBF 031*036 PPNATM 053*005 PSYMVC 144 025
NOINT5 069 029 NVSKBG 062 029 PAUSFL 030 038 PLTTBP 031*035 PPPAG 142 018 PSYMX 143 031
NOINTA 069 063 NVSKFL 062 059 PBFTY 032 006 PLUS0 021*039 PPTBL 142 017 PTCSIZ = 002 045
NOINTE 069 004 NVSKFX 062 034 PBIND 166 038 PLUS3 021*042 PPTBL1 146 005 PTRCHK 159 028
NOPFLS 032 051 NVSKIP 062 041 PBIND1 166 041 PLUS6 021*043 PPTBL2 146 009 PUFY 144 049
NOQUIT 015 019 NVSKP2 062 040 PBNSIZ 026*040 PLUS8 021*050 PPTBL3 146 033 PURCHK 221 111
NORET 068*004 NVSKTB 062 046 PCXSIZ 026*038 PNBFA1 052 043 PPTBL4 146 039 PURERR 184 035
NORMF 022*034 NXFLPS = 230 057 PDBSIZ 026*037 PNBFAT 052 042 PPTBL5 146 042 PURIFY 147 006
NOSHAR = 221*091 NXFXPS = 230 056 PDLA2 218 051 PNBFM6 052 063 PPTBL6 146 017 PURPGI 193 008
NOT 086 009 NXPSG = 230 058 PDLARG 218 046 PNBFMK 052*053 PPTBL7 146 044 PURPGI 194 010
NOTNOT 086 005 NXSPSG = 230 059 PDLB 103*078 PNBP 022 016 PPTBL8 146 058 PURPGS 221 121
NOUUO 068*012 OBNSIZ 025*038 PDLCHK 043 037 PNBUF 022 019 PPTBL9 146 055 PURTBL 034 035
NPAGS = 007 036 OBTSIZ = 002 044 PDLCRP 043*045 PNCONS 072 049 PRINLV 021 038 PUTPRO 084 015
NPDLH 027 024 OBTSIZ = 005 045 PDLFL1 027 028 PNG2 072 052 PROG 166*004 PX1J 059*051
NPDLL 027 023 OC2 027*071 PDLFL2 027 029 PNGET 082 048 PROG2 175*004 PXDFLJ 059 054
NPFFB 023*041 OCXSIZ 025*036 PDLFLS 047 101 PNGNK 072 004 PROGN 175*013 PXTTTJ 060*049
NPFFC 023*039 ODBSIZ 025*035 PDLHAK 016 018 PNGNK1 072 011 PROGN1 175 015 QHAT 022*035
NPFFD 023*038 ODCL 031*033 PDLNKJ 094 011 PNGNK2 072 012 PROGV 166*049 QIO = 002 048
NPFFH 023*043 ODXSIZ 025*037 PDLNMK 094 012 PNGT0 082 050 PROLIS 024 018 QITC 015 029
NPFFL 023*037 OEVAL 152*030 PDLORG = 230 080 PNGT1 082*049 PROTB 223 010 QITD 015 030
NPFFS 023 035 OFLC2 027*072 PDLORG = 230 094 PNMK1 020 052 PRPLSE 080 019 QITR 015 031
NPFFX 023*036 OFLSIZ 025*034 PDLSTA 016*031 PNMK2 094 030 PRPNIL 080 026 QUIT 114 002
NPFFY2 023 046 OFSSIZ 025 032 PDLSTB 016*032 PNPUT 138*027 PRPRCT 021*052 QUOTE 165*003
NPFFZ 023*040 OFXC2 027*073 PDLSTC 016*033 POF 142 014 PRSGLK 026 019 R 071 024
NPGTPS = 011*005 OFXSIZ 025*033 PDLSTH 016 027 POF1 144 018 PRXIT 166 067 R5M1PJ 060 020
NPRO = 011 015 OHNSIZ 025*040 PDXSIZ 026*039 POFF 032 033 PS.S 032 040 R70 064 009
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page VII
RBACK 030*068 RPLACD 175*031 SAPWIN 116 038 SEGKSM = 008*006 SPDLOR = 230 079 STENT 080 042
RBLOCK 030*069 RPLACX 076 028 SARGET 082*038 SEGLOG = 005 042 SPDLOR = 230 093 STORE 174 004
RCLOK1 190 016 RPLCD2 175 039 SARTOB 047 090 SEGMSK = 008 005 SPEC1 048 006 STORE7 174*012
RCLOK2 190 042 RPLCD3 175 036 SAS0 081 012 SEGMSK V 008 006 SPEC2 048 010 STORE9 174 023
RCT 034*011 RPLIZ 080 030 SAS1 081 014 SEGSIZ = 008 004 SPEC3 048 042 STQLUZ 032 046
RCT0 149 010 RPLX2 076 040 SAS1A 081 022 SET 102 039 SPEC4 048 037 STQPUR 050 020
RD0S3 032*042 RPSNIL 080 038 SAS1B 081 024 SET1 165 017 SPEC5 048 036 STRTOU 219 003
RDBKBF 021*059 RQITR 201 047 SAS1C 081 019 SETARG 141*047 SPEC6 048 026 STTYS 221 077
RDBKC 021*060 RRDF 020 034 SAS2 081 009 SETCK 102 048 SPECBI 048 005 STTYS1 030 040
RDDSV 021*062 RSAVE 022*043 SAS3 081 030 SETPLI 080*032 SPECX 014 016 STTYS2 030 041
RDIBS 021*063 RSSBLK 221 060 SAS3A 081 027 SETQ 165*016 SPP 030*036 STTYSS 030 039
RDINCH 021*065 RSSYN1 125 012 SAS4 081 048 SETSYN 125*006 SPROG2 084 034 STUMBL M 008 037
RDL12 107*040 RSSYN2 125 017 SASGLK 026 013 SETXIT 014 013 SPROG3 091 051 SUBL1 121 038
RDNSV 021*061 RSSYN3 125 022 SASSOC 081 003 SETZ ← 131 052 SPSV 014 066 SUBL1A 121 054
RDOBCT 020 019 RSSYN4 125 048 SASSQ 081*002 SETZ ← 132 076 SPTB 174 068 SUBL1B 121 043
RDOBJ8 030*048 RSSYN5 125 031 SATOB1 047 092 SFLSIZ 025*021 SPWIN 227 040 SUBL2 122 002
RDROMP 021*064 RSSYN7 125 038 SATOB7 047 095 SFSSIZ 025 019 SPWIN1 227 048 SUBL3 122 007
REALCL 190 006 RSSYN8 125 041 SAV3 060*011 SFSTO M 013 022 SPWR 016 011 SUBL3A 122 006
REDEFI 004*044 RST2 060*017 SAV5 060 004 SFSTO M 013 042 SPWR0 225 005 SUBL3Q 121 065
REMFL 022*025 RST3 060*016 SAV5M1 060 005 SFX M 013 016 SQ6BIT 029*015 SUBL3Z 121 067
REMOB 141*004 RST5M1 060 021 SAV5M2 060*006 SFX M 013 036 SQSQOZ 029*016 SUBL4 122 021
REMOB1 141 032 RST5M2 060*027 SAV5M3 060 007 SFXSIZ 025*020 SRNLN1 030 037 SUBLIS 121 034
REMOB2 141*010 RST5M3 060 032 SAVHGH 116 010 SFXTBI 223 007 SSASIZ 025*028 SUBLOS 121 060
REMOB3 141 019 RSTX1 060*055 SAVMAR 020 056 SFXTBL 223 004 SSCHTR 126 002 SUBRCA 159*002
REMOB4 141 026 RSTX2 060*054 SAVX3 060 041 SG = 230 075 SSGCPR 128 003 SUBS0A 091 039
REMOB7 141 011 RSTX3 060 053 SAVX5 060 036 SG = 230 089 SSGCRE 128 002 SUBS1 091*047
REMP0 085 006 RSTX5 060 046 SAWSP 032 053 SGADEV 033 164 SSGRL1 128 030 SUBS2 091 053
REMP1 085 007 RSXST 065 067 SB. = 145*031 SGAEXT 033 168 SSGRL2 128 029 SUBS3 091*059
REMP20 085*014 RSXTB 020 049 SBL1 122 024 SGANAM 033 161 SSM1 127 064 SUBS4 089*043
REMP3 085 033 RSXTB1 034*007 SBL2 122 043 SGAPPN 033 167 SSM3 127 052 SUBST 091*034
REMP3A 085 036 RSXTB2 149*006 SBL2A 122 046 SGS%PG = 008 009 SSM4 127 020 SUSCHS = 115 053
REMP7 085 019 RTSP1 032*022 SBL2B 122 053 SHAREP 221 092 SSM4AA 127 031 SUSP0 115 032
REMPRO 085 003 RTSP3 032*023 SBL4 122 038 SHNSIZ 025*027 SSMACR 127*002 SUSP0C 115 030
REPURE 142 006 RTTYS 221 066 SBL5 122 035 SIDDTP 113 065 SSMC43 127 011 SUSP1 115*076
RETHGH 033 103 RUNCLO 190 014 SBNSIZ 025*025 SIGNP 174*042 SSPROQ 128 018 SUSP11 115 036
RETTYP 159 010 RWG 032*026 SBSYM 142 007 SIGNP0 174*047 SSPROX 128 026 SUSP11 115 059
RETURN 166 064 S1PAJ 059 034 SC2 027 064 SIXAT1 052 032 SSSYN1 126*010 SUSP12 115 069
REV1 089 049 S2ILIN 180 037 SCSFAI 130 077 SIXATM 052 027 SSSYNT 126 005 SUSP14 115 088
REVERS 089*047 S2RUN 180 030 SCSL0 130*014 SIXC = 010*023 SSYSIZ 025*026 SUSP3 115 128
RHAPJ 166*073 S2SGLK 026*015 SCSL1 130 034 SIXJBN 045 030 ST 036 033 SUSP68 115 123
RINF 021 018 SADISM 180 026 SCSL1A 130 041 SIXMAK 052 005 STDHI = 011 045 SUSPEN 115 002
RINTER 106 004 SADMS0 180 025 SCSL3 130 059 SIXMK1 052 017 STDHI = 011 050 SUSTBL 115 044
RINTN0 106 006 SAHACK 180 015 SCSL4 130 062 SIXMK2 020 054 STDIFL 041 007 SVPRLK 026*020
RINTN1 106 024 SAIALK 030 078 SCSL5 130 069 SIXOPD 035*019 STDISP 036 038 SWNACK 021*053
RM4 021 051 SAICON 030 077 SCSL6 130 051 SJCLBU 033 173 STDLO = 011 044 SWS 020 013
RNOWS 030*067 SAIL = 002 029 SCSTAT 130 094 SMACRO 126*032 STDLO = 011 049 SXHASH 097 002
RNTM1 086*052 SAILIN 180 004 SCSTMA 130 074 SMCR1 126 037 STDMS2 = 181 032 SXHS1A 098 063
RNTN2 032 010 SAILIN 182 008 SCSXIT 130 085 SMCR2 127 061 STDMS2 = 181 033 SXHS1B 098 069
ROFSET = 030*060 SAILJO 030 079 SCSXT1 130 089 SMEMQ 091 009 STDMSK = 009 047 SXHS1F 098 084
ROFSET = 030*064 SAINTE 030 076 SCXSIZ 025*023 SPAT1 080*014 STDMSK = 009 055 SXHSC1 098 047
RP = 145*037 SALCK0 140 064 SDBSIZ 025*022 SPATOM 080 013 STDMSK = 181 026 SXHSD1 098 038
RPLACA 175*024 SAMEPN 123*004 SDXSIZ 025*024 SPCFLS 042 042 STDMSK = 181 027 SXHSD2 098 042
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page VIII
SXHSH0 097 021 TLEVAL 043 016 TYPK1H 112*043 UINT0N 198 027 UNBND1 049 036 UUL2N 217 002
SXHSH4 098 009 TLPR1 044 048 TYPK3 110 048 UINT0N 200 061 UNBND2 014 005 UULT 207*024
SXHSH5 098 016 TLPRIN 044 038 TYPK3 112 046 UINT0Q 198 032 UNBND3 020 053 UUMCT 207*040
SXHSH6 098 020 TLRCT = 150 043 TYPK3B 110 049 UINT0V 198 036 UNLKFA 059*047 UUN 030*030
SXHSH7 098 005 TLREAD 042 016 TYPK3C 112 050 UINT0X 198 009 UNLKTR 059*048 UUNAF 207 033
SXHSH8 098 002 TLRED1 042 024 TYPK4 110 011 UINT0X 200 045 UNMTMP 020*061 UUOACL 205 028
SXHSH9 098 024 TLRED2 042 034 TYPK4 112 052 UINT0Y 198 039 UNRC.G 028 018 UUOACS 209 046
SXHSZ1 098 052 TLSYM 142 010 TYPK4A 110 023 UINT0Z 198 042 UNRCLI 028*019 UUOAJC 205 030
SYCON1 072 033 TLTER1 041 045 TYPK4D 110 020 UINT0Z 200 067 UNREAL 015 026 UUOAR2 210 033
SYCON2 072 026 TLTERP 041 028 TYPK5 110 037 UINT1 204 013 UNREAR 028 023 UUOARR 210 002
SYCON4 072 036 TLTERX 041 038 TYPK5 112 058 UINT1A 204 024 UNRMAR 028*020 UUOBAK 208 010
SYCONS 072 013 TLVRS1 045*007 TYPK5A 110 039 UINT1Q 204 031 UNRRUN 028 021 UUOBK0 208 017
SYM = 004 029 TLVRSS 045 004 TYPK6 111 004 UINT1R 204 019 UNRTIM 028 022 UUOBK1 208 028
SYMDEF M 006 057 TMDAM2 192 030 TYPK6 112 061 UINT1S 204 053 UPCHK 179 038 UUOBK5 208 038
SYMEV0 157 005 TMDAMI 192 025 TYPK6A 111 012 UINT1T 204 045 UPCHK1 179 043 UUOBK6 208 039
SYMEVA 157 006 TMPC 017 021 TYPK6B 111 006 UINT1U 204 047 UPCOK 030 024 UUOBK7 208 016
SYMFLS M 006 039 TMPC = 010 008 TYPK7 111 026 UINT2 196 031 UPIINT 015 065 UUOBK8 208 029
SYMLO 030*023 TOF 142 015 TYPK7A 111 036 UINT26 197 016 URCHST 032*003 UUOBKG 022 068
SYSCAL 130*006 TOF1 144 017 TYPK7B 111 040 UINT27 198 048 URFN1 030*033 UUOBNC 208 006
SYSCL8 021 034 TOP.PG = 035 082 TYPK7D 111 052 UINT3 196 034 URFN2 030*034 UUOE2 211 006
SYSFIL 221 116 TOPN = 011*006 TYPK9 112 066 UINT30 200 004 USELES = 002 051 UUOE3 210 051
SYSGLK 026 011 TOPS10 = 002 027 TYPK9A 112 067 UINT31 200 011 USN 030 004 UUOEX2 216 005
SYSINT 191 018 TOPS20 = 002 028 TYPNIL 093 015 UINT32 200 014 UTBSIZ = 035 032 UUOEX4 216 011
SYSP 123*033 TOTSPC 032*017 TYPX 110 033 UINT33 200 025 UTBSIZ = 035 037 UUOEXP 216 009
SYSP3 123 034 TRUE 086 011 UAPOS 021*010 UINT4 196 077 UTBSIZ = 035 049 UUOFN 022 062
SYSP6 123 052 TSAVE 022*041 UBD 049 005 UINT40 200 029 UTIB 035 041 UUOFUL 212 045
T. = 145*029 TSYM 142 011 UBD0 049 003 UINT42 197 019 UTIB 035 062 UUOGLE 012 033
TABLU1 021 020 TTRINT 191 013 UBD1 049 020 UINT43 198 052 UTIBP 035*040 UUOH 022 058
TBLPUR = 145*032 TTY 004 046 UBD3 049 019 UINT45 200 074 UTIBP 035*052 UUOH0 205 006
TENEX = 002 030 TTYDF1 = 181 057 UBD4 049 023 UINT46 200 075 UTIBYT 035*053 UUOH0A 206 013
THIRTY = 012 004 TTYDF2 = 181 058 UBVB 103*063 UINT49 200 081 UTIC = 010*011 UUOH0B 206 004
THROW 172*051 TTYDIS 030 042 UDFB 103*060 UINT55 197 024 UTIHED 035*051 UUOH0C 206 031
THROW1 054 014 TTYIC1 189 014 UFN1 030 031 UINT56 198 056 UTIN 030 009 UUOH1 206 022
THROW3 054 050 TTYICH 189 009 UFN2 030 032 UINT88 200 069 UTIOPD 030 008 UUOH1A 206 040
THROW4 054 027 TTYIF1 018*007 UGTB 103*069 UINT90 200 083 UTOB 035 043 UUOH2 205 010
THROW5 054 010 TTYIF2 018 010 UIBRK 058 003 UINT91 200 088 UTOB 035 064 UUOH2A 205 013
THROW6 054 017 TTYIN0 179 021 UIFCLI = 195 038 UINTEX 196 017 UTOBP 035*042 UUOH3B 206*049
THROW7 054 022 TTYINT 177 044 UIFMAR = 195 039 UINTPU 196 042 UTOBP 035*056 UUOLB3 212 024
TI.BFN 018*015 TTYINT 179 016 UIFRM = 199 054 UINTX1 196 025 UTOBYT 030*006 UUOLB4 212 028
TI.ST1 018*042 TTYOF1 019*007 UIFSYS = 195 041 UIRTN 020 046 UTOBYT 035*057 UUOLSB 212 008
TI.ST2 018*046 TTYOF2 019 010 UIFTTR = 195 040 UISAVA = 199 055 UTOC = 010*012 UUONVL 210 041
TI.ST3 018*050 TTYOPN 221 011 UIMILO 184 057 UISAVT = 199 048 UTOHED 035*055 UUOS 216 008
TI.ST4 018*051 TWENTY = 012 003 UIMILO = 195 029 UISTAK 016 004 UTOOPD 030 007 UUOS0 210 006
TIME 087 010 TYIC = 010 009 UIMMPV 184 059 UISTK1 192 012 UUALT 207 038 UUOS03 210 008
TIME3 087 031 TYIPEE 110 006 UIMMPV = 195 031 UISTK1 196 062 UUALT1 207 043 UUOS0E 211 002
TIME8 087 062 TYIPEE 112 004 UIMPAR 184 056 UISTK2 192 018 UUALT9 022 066 UUOS0F 211 003
TIMO1 178 029 TYOC = 010 010 UIMPAR = 195 028 UISTK2 196 071 UUAT 207 015 UUOS1 211 025
TIMO3 178 017 TYOSW 021 055 UIMWRO 184 058 UISTK3 196 073 UUBKG1 208 014 UUOS10 216 033
TIMO6 178 024 TYPEP 093*011 UIMWRO = 195 030 UISWS = 199 047 UUET 207*027 UUOS11 215 033
TIMO7 178 034 TYPK1 112 027 UINT 196 007 UIXPUS = 199*046 UUF2N 215 008 UUOS1A 214 030
TIMOUT 178 005 TYPK1C 112 029 UINT0 197 011 UNBIND 049 033 UUFET 207*030 UUOS1E 210 046
TL. = 145*030 TYPK1F 112 041 UINT0 199 023 UNBND0 049 035 UUFST 207*021 UUOS2 214 009
Symbol Table for: LISP.393[MAC,LSP] 01/17/78 Page IX
UUOS2A 214 003 UUOX4B 212 002 VLRT3 113 050 XFXP 027 051 ZFFH 025*014 ZZX = 230 087
UUOS2E 210 049 UUOXCT 209 035 VLRT3A 113 052 XHUNK0 079 004 ZFFL 025*008 ZZX = 230 090
UUOS2Q 214 011 UUOXIT 209 030 VLRT9 113 014 XHUNK1 079 024 ZFFS 025 006 ZZZ = 004 063
UUOS3 216 003 UUOXT0 209 028 VLRT9 113 061 XHUNK2 079 026 ZFFX 025*007 ZZZ = 004 065
UUOS4 215 004 UUOXT1 209 031 WAITA 015 057 XHUNK5 079 034 ZFFY 025*013 ZZZ = 005 013
UUOS4A 216 004 UUPSV 022 067 WAITD2 015 058 XHUNK6 079 020 ZFFZ 025*011 ZZZ = 008 038
UUOS5 217 003 UURSV 022 065 WAITFL 015 056 XHUNK7 079 054 ZFLP 027*055 ZZZ = 008 049
UUOS5A 217 011 UUS10A 216 035 WAKTTY 221 073 XLL 031*025 ZFXP 027*056 ZZZ = 034 042
UUOS5B 217 019 UUST 207*018 WAKTTY 221 087 XPATCH 230 007 ZPDL 027 054 ZZZ = 034 065
UUOS5C 217 047 UUTSV 022 063 WNAB 103*072 XPDL 027 049 ZPOPJ 059 025 ZZZ = 037 033
UUOS6 215 009 UUTTSV 022 064 WTAB 103*066 XSPDL 027*052 ZSC2 027 068 ZZZ = 037 036
UUOS6Q 215 029 UWRT 030*011 XBLOKS 031*022 XUINT 183 053 ZSPDL 027 057 ZZZ = 037 037
UUOS7 213 003 UWUSN 030*016 XC 064 014 XUINT9 183 063 ZZ = 035 033 ZZZ = 064 011
UUOS7A 213 018 VALRET 113 004 XCONS 073 009 XUR 031*027 ZZ = 035 079 ZZZ = 064 012
UUOS7H 213 025 VALSTR 113 019 XCT ← 209 025 YAGDBT 022 040 ZZ = 145 005 ZZZ = 087 063
UUOS7K 213 028 VANISH V 126*063 XFFA 027*044 YBLOKS 031*023 ZZ = 150 045 ZZZ = 087 066
UUOS9 213 002 VBIND 166 037 XFFB 027*041 YESIN1 192 010 ZZ = 230 029 ZZZ = 131 050
UUOSB2 209 007 VC. = 145*027 XFFC 027*039 YESIN1 196 060 ZZM M 013 023 ZZZ = 131 052
UUOSB3 209 008 VCL. = 145*028 XFFD 027*038 YESINT 197 008 ZZM M 013 043 ZZZ = 132 074
UUOSB4 209 024 VCLSYM 142 008 XFFH 027*043 YESINT 199 020 ZZN M 013 026 ZZZ = 132 076
UUOSB5 209 009 VCSYM 142 009 XFFL 027*037 YLL 031*026 ZZN M 013 046 ZZZ ← 037 036
UUOSB6 209 013 VERSIO = 002 017 XFFS 027 035 YUR 031*028 ZZW = 034 040 ZZZ ← 037 037
UUOSB7 209 017 VETBL0 022*026 XFFX 027*036 ZFFA 025*015 ZZX = 034 059 ZZZ V 034 071
UUOSBR 209 003 VIDC = 010*017 XFFY 027*042 ZFFB 025*012 ZZX = 034 061 ZZZ V 034 072
UUOSE1 211 021 VLRT1 113 042 XFFZ 027*040 ZFFC 025*010 ZZX = 230 073 ZZZZZZ M 004 026
UUOTRT 207 004 VLRT2 113 024 XFLP 027 050 ZFFD 025*009 ZZX = 230 076